arrays - If Next statement does not work after the second time loop in VB

Question

I'm very confused why this if statement doesn't work after the second loop. I want to pick up the cells which start with "[" and extract the sentence between the "[]". Once extracted, the sentence should be put on the different sheet as a list.

This code works only first time when InStr(Cells(i, 1), "[") > 0. However, this test fails thereafter.

Where am I going wrong?

Public rowCount As Integer
    
Sub Copy()
    Dim startNum As Integer, endNum As Integer
    Dim str As String
    Dim e As Long
    Dim le As Long
    
    Worksheets("DataBase").Activate
    rowCount = Cells(Rows.Count, 1).End(xlUp).Row 
    Dim i As Long
    Dim ExtractionStrings As String
    Dim arr() As Variant
    
    For i = 4 To rowCount
        For e = 1 To rowCount
            If InStr(Cells(i, 1), "[") > 0 Then
            startNum = InStr(Cells(i, 1), "【")
            endNum = InStr(startNum + 1, Cells(i, 1), "]")
            If startNum <> 0 And endNum <> 0 Then
                startNum = startNum + 1
                ExtractionStrings = Mid(Cells(i, 1), startNum, endNum - startNum)
                str = ExtractionStrings
                
                Worksheets("Sheet1").Activate
                Cells(i, 1) = str
                Else: MsgBox ("Error")
                End If
            End If
        Next e
    Next i
End Sub

Answer 1

That is happening because when the first match takes place in loop, you are activating the output worksheet “Worksheets(“Sheet1).Activate” so the next iteration, the Instr evaluation takes place in output worsheet.

It′s better to have always a variable for your worksheets like:

 Dim myWsh 
 Set myWsh  = Workbook("x").sheets(1)

So in further code you can reference ojects inside your worksheet without activating it:

myWsh.cells(1,1).value = "my value"

Please try the following, I have added the worksheets variables and remove the inner loop (don′t really know what that was for)

Option Explicit

Public rowCount As Integer
    
Sub Copy()
     
    Dim databaseWsh As Worksheet:  Set databaseWsh = ThisWorkbook.Worksheets("DataBase")
    Dim outputWsh As Worksheet:  Set outputWsh = ThisWorkbook.Worksheets("Sheet1")
    
    Dim rowCount As Long: rowCount = databaseWsh.Cells(databaseWsh.Rows.Count, 1).End(xlUp).Row
    Dim outPutCount As Long: outPutCount = 1
    
    Dim i As Long
    For i = 1 To rowCount
            
            Dim startNum As Integer: startNum = 0: Dim endNum As Integer: endNum = 0
            If InStr(1, databaseWsh.Cells(i, 1), "[") > 0 Then
                startNum = InStr(1, databaseWsh.Cells(i, 1), "[")
                endNum = InStr(startNum + 1, databaseWsh.Cells(i, 1), "]")
                    If startNum <> 0 And endNum <> 0 Then
                        Dim ExtractionStrings As String
                        startNum = startNum + 1
                        ExtractionStrings = Mid(databaseWsh.Cells(i, 1), startNum, endNum - startNum)
                        outputWsh.Cells(outPutCount, 1) = ExtractionStrings
                        outPutCount = outPutCount + 1
                    Else: MsgBox ("Error")
                    End If
            End If
    Next i
    
End Sub