查找具有特定字符串值的范围内的所有单元格

Question

I am getting a bit crazy in trying to understand why the below code is not working properly.

Basically I have a sheet with currencies in different columns and in col B a series of descriptions. What I am doing is using the FIND function to look up 'GBP' column and 'LCH ISSUE DESCRIPTION' row. I need the column and row number of the two as in Cells('LCH ISSUE DESCRIP.row, GBP.column) I have the info I need and which I am putting in a separate tab using the SPLIT function.

The issue is that 'LCH ISSUE DESCRIPTION' appears multiple times in col B, which means I have to use FIND function in a loop. The code works fine for the first instance, but then instead of hitting the subsequent cell (row) containing the same value , it simply moves down one row. Any idea what am I doing wrong?

Sub get_macdata_1()

Dim LastCell As Range, issuerFound As Range
Dim shName As String, issuer As String, ccy As String, inputText As String, firstaddress As String
Dim ccyColumn As Integer, issuerRow As Integer
Dim i As Long, r As Long
Dim splitText As Variant

ccy = "GBP"
issuer = "LCH ISSUE DESCRIPTION"
shName = "December 2014"

ccyColumn = Worksheets(shName).Cells.Find(What:=ccy, LookIn:=xlValues, LookAt:=xlWhole).Column

With Worksheets(shName).Range("B:B")
Set LastCell = .Cells(.Cells.Count)
End With

Set issuerFound = Worksheets(shName).Range("B:B").Find(What:=issuer, After:=LastCell, LookAt:=xlWhole)
If Not issuerFound Is Nothing Then
    firstaddress = issuerFound.Address
End If

        Do Until issuerFound Is Nothing

        issuerRow = issuerFound.Row
        inputText = Cells(issuerRow, ccyColumn).Value
        splitText = Split(inputText, " ")

        r = Worksheets("mac_data").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
            For i = 0 To UBound(splitText)
                Sheets("mac_data").Cells(r + 1, i + 1) = splitText(i)
            Next i

        'Worksheets(shName).Activate
        Set issuerFound = Worksheets(shName).Range("B:B").FindNext(After:=issuerFound)

            If issuerFound.Address = firstaddress Then
                Exit Do
            End If

        Loop


End Sub

Answer 1

I was able to replicate what I think your issue is on my own version of what I think your workbook is. The replicated error made every cell copy over to the "mac_data" tab between the first and last found "LCH ISSUE DESCRIPTION", instead of just the matching cells.

I was able to fix it by changing Set issuerFound = Worksheets(shName).Range("B:B").FindNext(After:=issuerFound) to Set issuerFound = Worksheets(shName).Range("B:B").Find(What:=issuer, After:=issuerFound, LookAt:=xlWhole)

The full code looks like this:

Sub get_macdata_1()

Dim LastCell As Range, issuerFound As Range
Dim shName As String, issuer As String, ccy As String, inputText As String, firstaddress As String
Dim ccyColumn As Integer, issuerRow As Integer
Dim i As Long, r As Long
Dim splitText As Variant

ccy = "GBP"
issuer = "LCH ISSUE DESCRIPTION"
shName = "December 2014"

ccyColumn = Worksheets(shName).Cells.Find(What:=ccy, LookIn:=xlValues, LookAt:=xlWhole).Column

With Worksheets(shName).Range("B:B")
Set LastCell = .Cells(.Cells.Count)
End With

Set issuerFound = Worksheets(shName).Range("B:B").Find(What:=issuer, After:=LastCell, LookAt:=xlWhole)
If Not issuerFound Is Nothing Then
    firstaddress = issuerFound.Address
End If

        Do Until issuerFound Is Nothing

        issuerRow = issuerFound.Row
        inputText = Cells(issuerRow, ccyColumn).Value
        splitText = Split(inputText, " ")

        r = Worksheets("mac_data").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
            For i = 0 To UBound(splitText)
                Sheets("mac_data").Cells(r + 1, i + 1) = splitText(i)
            Next i

        'Worksheets(shName).Activate
        Set issuerFound = Worksheets(shName).Range("B:B").Find(What:=issuer, After:=issuerFound, LookAt:=xlWhole)

            If issuerFound.Address = firstaddress Then
                Exit Do
            End If

        Loop


End Sub

Hopefully this works for you!