Create Sheets Based on the Information in Two Columns

Question

I'm trying to create sheets if two specific strings are found in columns G and K in the same row.

No sheet is created after running the following code:

Sub CreateSheets()

    Dim newSheet As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim sheetExists As Boolean
    Dim ws As Worksheet
    
    ' Find the last row with data in column A
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    ' Check for the B2B GBP condition
    sheetExists = False
    For Each ws In ThisWorkbook.Sheets
        If ws.Name = "B2B GBP" Then
            sheetExists = True
            Exit For
        End If
    Next ws
    If Not sheetExists Then
        For i = 1 To lastRow
            If Cells(i, "K").Value = "GBP" And Cells(i, "G").Value = "OK - B2B" Then
                Set newSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
                newSheet.Name = "B2B GBP"
                Exit For
            End If
        Next i
    End If
    
    ' Check for the IMPORT GBP condition
    sheetExists = False
    For Each ws In ThisWorkbook.Sheets
        If ws.Name = "IMPORT GBP" Then
            sheetExists = True
            Exit For
        End If
    Next ws
    If Not sheetExists Then
        For i = 1 To lastRow
            If Cells(i, "K").Value = "GBP" And Cells(i, "G").Value = "OK - IMPORTACAO" Then
                Set newSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
                newSheet.Name = "IMPORT GBP"
                Exit For
            End If
        Next i
    End If

End Sub

What's wrong with the code?

Answer 1

Create Sheets Based on Two Columns

• You haven't qualified the sheet where you look for the strings i.e. it is the (currently selected) active sheet. I'm tagging the sheet Info sheet and naming it Sheet1 (change as required). Once you add a sheet, it becomes the active sheet so your code will look for the strings in the wrong sheet. Always qualify Range, Cells, Rows, Columns with a worksheet i.e. iws.Range, iws.Cells, iws.Rows, iws.Columns respectively. Also, qualify each sheet with a workbook e.g. Set ws = wb.Sheets("Sheet1").
• Use constants at the top of the code to easily modify their values in one place.
• Reference the workbook right after so if you want to change it, you'll have to do it only once.
• When you declare a Worksheet variable, always loop through the Worksheets collection instead of the Sheets collection that includes charts.
• Once you start repeating (copy/pasting) similar code, it's time to use arrays or another data structure (e.g. dictionary, collection).
• Note that there are quite a few assumptions i.e. the code could be improved on at least that many accounts. I didn't do it not to add further complications to the already many changes.

Sub CreateSheets()
    
    Const INFO_SHEET_NAME As String = "Sheet1"
    Const INFO_FIRST_ROW As Long = 1
    Const INFO_LAST_ROW_COLUMN As String = "A"
    Dim InfoColumns() As Variant: InfoColumns = VBA.Array("G", "K")
    Dim NewNames() As Variant: NewNames = Array("B2B GBP", "IMPORT GBP")
    Dim Strings1() As Variant: Strings1 = Array("OK - B2B", "OK - IMPORTACAO")
    Dim Strings2() As Variant: Strings2 = Array("GBP", "GBP")
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Assuming the Info sheet is in the same workbook ('ThisWorkbook').
    Dim iws As Worksheet: Set iws = wb.Sheets(INFO_SHEET_NAME)
    
    Dim iLastRow As Long:
    iLastRow = iws.Cells(iws.Rows.Count, INFO_LAST_ROW_COLUMN).End(xlUp).Row
    
    Dim nws As Worksheet, i As Long, n As Long, WorksheetExists As Boolean
    Dim nName As String, Str1 As String, Str2 As String
    
    For n = LBound(NewNames) To UBound(NewNames)
        nName = NewNames(n)
        ' Check if a worksheet with the specific name exists,
        ' assuming there can be no chart with the same name.
        WorksheetExists = False
        For Each nws In wb.Worksheets
            ' This is a case-insensitive comparison i.e. 'A = a'.
            If StrComp(nws.Name, nName, vbTextCompare) = 0 Then
                WorksheetExists = True
                Exit For
            End If
        Next nws
        If Not WorksheetExists Then
            Str1 = Strings1(n)
            Str2 = Strings2(n)
            ' Attempt to match the two strings in the same row,
            ' assuming there are no errors in the columns.
            For i = INFO_FIRST_ROW To iLastRow
                ' This is a case-sensitive comparison i.e. 'A <> a'.
                If iws.Cells(i, InfoColumns(0)).Value = Str1 _
                        And iws.Cells(i, InfoColumns(1)).Value = Str2 Then
                    Set nws = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
                    nws.Name = nName
                    Exit For
                End If
            Next i
        End If
    Next n

End Sub