Carlsberg789
Carlsberg789

Reputation: 155

VBA search looping through ranges

I have a situation where I have numbers in column A. I want to know if these numbers are found in column B. For example: A1 has the number 5554 and A2 has the number 163. B1 is 00051631 and B2 is 0000055549. The code should do the following: Search if one of the cells in column B contains 5554. Then move on to A2 and do the same.

Therefore both of these should return "true", as both numbers in column A exist in cells of column B.

Sub Search()

Dim StartCell As Integer
Dim EndCell As Integer
Dim i As Integer 'row counter
Dim x As Integer 'row counter2
Dim InvoiceNumber As Integer


StartCell = Worksheets("Sheet1").Range("A1")
EndCell = Worksheets("Sheet1").Range("A1048576").End(xlUp).Row

For i = 1 To EndCell
    InvoiceNumber = Cells(i, 1)
    If InStr(1, Cells(i, 2), InvoiceNumber) > 0 Then
    Cells(i, 3).Value = InvoiceNumber
    End If

Next i

End Sub

So basically what the above does is if A1 exists in B1, but it doesnt move on to check for B2 and so on...

Any solutions?

Thanks!

Upvotes: 1

Views: 175

Answers (4)

JvdV
JvdV

Reputation: 75840

Assuming:

  • both your columns are actually numbers formatted as text (as per the leading zeros)
  • You need to return TRUE or FALSE as per your statement: "....Therefore both of these should return "true"

You could decide not to iterate over column B again and again. Instead you can perform a Find looking for values within values of column B:

Sample Code:

Sub Test()

Dim lr1 As Long, lr2 As Long, x As Long
Dim arr As Variant
Dim rng As Range, cl As Range

With Sheet1 'Change according to your sheets CodeName

    'Fill the array for a loop in memory
    lr1 = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr = .Range("A1:A" & lr1)

    'Get the range to look in
    lr2 = .Cells(.Rows.Count, 2).End(xlUp).Row
    Set rng = .Range("B1:B" & lr2)

    'Loop over the array and perform the search
    For x = LBound(arr) To UBound(arr)
        Set cl = rng.Find(arr(x, 1), LookIn:=xlValues)
        If Not cl Is Nothing Then
            .Cells(x, 3) = True 'If you want to insert boolean value
            '.Cells(x,3) = cl 'If you want to insert the found value
            '.Cells(x,3) = arr(x,1) 'If you want to insert the search value
        Else
            .Cells(x, 3) = False
        End If
    Next 

End With

End Sub

Another way would be to work through memory without Find:

Sub Test()

Dim lr1 As Long, lr2 As Long, x As Long
Dim arr1 As Variant, arr2 As Variant, arr3 As Variant

With Sheet1 'Change according to your sheets CodeName

    'Fill the first array for a loop in memory
    lr1 = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr1 = .Range("A1:A" & lr1)

    'Fill the second array for a filter
    lr2 = .Cells(.Rows.Count, 2).End(xlUp).Row
    arr2 = Application.Transpose(Application.Index(.Range("B1:B" & lr2), 0, 1))

    'Loop over the array and perform the search
    For x = LBound(arr1) To UBound(arr1)

        'Return an array of filtered values
        arr3 = Filter(arr2, arr1(x, 1))

        'Do something with the returned array
        If UBound(arr3) > -1 Then
            .Cells(x, 3) = True 'If you want to insert boolean value
            '.Cells(x,3) = arr3(1) 'If you want to insert the found value
            '.Cells(x, 3) = Join(arr3, ",") 'if you want to show all found values
            '.Cells(x,3) = arr(x,1) 'If you want to insert the search value
        Else
            .Cells(x, 3) = False
        End If
    Next

End With

End Sub

In both cases you might want to make sure you also format column C as text.

Upvotes: 1

Kevin
Kevin

Reputation: 2631

I know you are using VBA, but you know this could be done in a couple of ways using just an Excel formula:

=INDEX(B:B, MATCH("*" &A1&"*",B:B,0))

Upvotes: 0

Vitaliy Prushak
Vitaliy Prushak

Reputation: 1162

Here is my version

Sub Search()

Dim StartCell As Integer
Dim CellSource As Range
Dim CellSearch As Range
Dim SourceRange As Range
Dim SearchRange As Range
Dim testValue As String


Dim i As Integer 'row counter
Dim x As Integer 'row counter2
Dim InvoiceNumber As Integer


StartCell = Worksheets("Sheet1").Range("A1") ' a you sure you need this?
SourceRange = Range(Cells(Rows.Count, 1).Cells(Rows.Count, 1).End(xlUp))
SearchRange = Range(Cells(Rows.Count, 1).Cells(Rows.Count, 1).End(xlUp))


For Each CellSource In SourceRange
    For Each CellSearch In SearchRange
        testValue = "*" & CellSource & "*"
        If CellSearch Like testValue Then
            CellSource.Offset(0, 2).Value = CellSource
        End If
    Next
Next i

End Sub

Upvotes: 0

Michał Turczyn
Michał Turczyn

Reputation: 37337

You don't loop over B column at all, that's why you are having problem.

It is better to store row number in variable and loop between those variables:

Dim startRow As Long, endRow As Long
For aRow = startRow To endRow
  invoiceNumber = Cells(aRow, 1).Value
  For bRow = startRow To endRow
    If InStr(1, Cells(bRow, 2).Value, invoiceNumber) > 0 Then
      Cells(aRow, 3).Value = invoiceNumber
      Exit For
    End If
  Next
Next 

Upvotes: 0

Related Questions