npc-tavern-gen-utility.vb

Option Explicit
Public Sub ClearNPC()
    Dim Conf As String
    
    'Conf = MsgBox("Are you sure you want to clear the NPC Generator form?", vbOKCancel, "Are you sure?")
    
    'If Conf = vbOK Then
        Sheets("NPC Generator").Range("NPCName").Value = ""
        Sheets("NPC Generator").Range("NPCRace").Value = ""
        Sheets("NPC Generator").Range("NPCGender").Value = ""
        Sheets("NPC Generator").Range("NPCNameRegion").Value = ""
        Sheets("NPC Generator").Range("NPC").Value = ""
    'End If
End Sub
Private Sub CreateOtherTables()
    Dim i, j, k, M As Integer
    
    Dim Title As String
    
    Dim EOL As Boolean
    
    i = 1
    j = 1
    k = 1
    
    Do
        Range("A1").Activate
        i = i + 1
        Title = ActiveCell.Offset(0, i - 1).Value
        
        If Not Title = ActiveCell.Offset(0, i).Value Then
            'Get end of list
            Do Until EOL = True Or k > 10000
                k = k + 1
                
                For M = j To i
                    If ActiveCell.Offset(k, M - 1).Value = "" Then
                        EOL = True
                    Else
                        EOL = False
                        Exit For
                    End If
                Next
            Loop
            EOL = False
            
            If k = 2 Then k = 3
        End If
        
        If k > 1 Then
            Range(N2L(CLng(j)) & "1:" & N2L(CLng(i)) & k).Select
            k = 1
            'Range(Selection, Selection.End(xlDown)).Select
            
            Selection.ClearFormats
            
            ActiveSheet.ListObjects.Add(xlSrcRange, Range(Selection.Address), , xlYes).Name = Replace(Title, " ", "")
            ActiveSheet.ListObjects(Replace(Title, " ", "")).TableStyle = "Table Style 1"
            
            j = i + 1
        End If
    Loop Until Range("A1").Offset(0, i).Value = ""
    
End Sub
Private Sub CreateNameTables()
    Dim i, j, k, M As Integer
    
    Dim Race As String
    
    Dim EOL As Boolean
    
    i = 1
    j = 1
    k = 1
    
    Nonames = False
    
    Do
        Range("A1").Activate
        i = i + 1
        Race = ActiveCell.Offset(0, i - 1).Value
        
        If Not Race = ActiveCell.Offset(0, i).Value Then
            'Get end of list
            Do Until EOL = True Or k > 10000
                k = k + 1
                
                For M = j To i
                    If ActiveCell.Offset(k, M - 1).Value = "" Then
                        EOL = True
                    Else
                        EOL = False
                        Exit For
                    End If
                Next
            Loop
            EOL = False
            
            If k = 2 Then k = 3
        End If
        
        If k > 1 Then
            Range(N2L(CLng(j)) & "2:" & N2L(CLng(i)) & k).Select
            k = 1
            'Range(Selection, Selection.End(xlDown)).Select
            
            Selection.ClearFormats
            
            ActiveSheet.ListObjects.Add(xlSrcRange, Range(Selection.Address), , xlYes).Name = Replace(Race & "Names", " ", "")
            ActiveSheet.ListObjects(Replace(Race & "Names", " ", "")).TableStyle = "Table Style 1"
            
            j = i + 1
        End If
    Loop Until Range("A1").Offset(0, i).Value = ""
    
End Sub

Private Sub SortColumns()
    Dim i, j, k As Long
    
    Dim ColCount As Integer
    Dim HRow As Double
    
    Dim ORange As Range
    Dim SRange As String
    
    Dim DumArray() As Variant
    
    Set ORange = Selection
    i = L2N(Replace(CStr(ORange.Address), "$", ""))
    
    DumArray() = Range(Selection, Selection.End(xlToRight)).Value
    
    ColCount = UBound(DumArray(), 2)
    HRow = Selection.Row
    
    j = i + ColCount - 1
    
    For k = i To j
        Range(N2L(k) & HRow).Select
        
        If k = j - 1 Then
            i = i
        End If
        
        If Not ActiveCell.Offset(1, 0).Value = "" Then
            Range(Selection, Selection.End(xlDown)).Select
            
            SRange = CStr(Selection.Address)
            
            ActiveSheet.Sort.SortFields.Clear
            ActiveSheet.Sort.SortFields.Add Key:=Range(SRange), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            With ActiveSheet.Sort
                .SetRange Range(SRange)
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        End If
    Next
End Sub