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
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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.