VBA Search Single Column - vba

Question

New to asking questions on this site, and to VBA so please bear with me... I'm compiling this database that is linking drawing numbers that show the same items but each drawing shows a different aspect of that particular 'area' shown in the drawing (I Hope that makes sense). The function that i would like to have is to be able to search just the A column for a value, and return the all of the unique times that the value shows up in the A column and the corresponding B column value. I thought that even with my paltry VBA skills i could manage this but I dont have much so far. This is what i have:
Dim ISO As String
Dim Rng As Range
ISO = InputBox("ISO Number: ", "Enter ISO Number")
If Trim(ISO) <> "" Then
With Sheets("Sheet1").Range("A:A")
Set Rng = .Find(What:=ISO)
If Not Rng Is Nothing Then
Application.Goto Rng, True
Else
MsgBox ("Nothing Found")
End If
End With
End If
Thanks in Advance.

Answer 1

I'd use a for loop to iterate over the cells.
Sub FindMatches()
Dim ISO As String
Dim Rng As Range
Dim lastRow As Long, x As Long
Dim ws As Worksheet
Dim foundCount As Long
Dim endString As String
ISO = InputBox("ISO Number: ", "Enter ISO Number")
If Trim(ISO) <> "" Then
Set ws = Sheets("Sheet1") ' always best to use a variable for an object if possible
lastRow = ws.Cells(100000, 1).End(xlUp).Row ' work out how many rows to loop through
For x = 1 To lastRow ' use a for loop to iterate over each row
If ws.Cells(x, 1) = ISO Then
foundCount = foundCount + 1
endString = endString & ws.Cells(x, 2) & vbNewLine ' add column B to the string
End If
Next x
End If
MsgBox "Found " & foundCount & " matches: " & vbNewLine & endString
End Sub
For faster processing you could use an array rather than read from the cells one at at time:
Sub FindMatchesArray()
Dim ISO As String
Dim Rng As Range
Dim lastRow As Long, x As Long
Dim ws As Worksheet
Dim foundCount As Long
Dim endString As String
Dim arr() As Variant
ISO = InputBox("ISO Number: ", "Enter ISO Number")
If Trim(ISO) <> "" Then
Set ws = Sheets("Sheet1") ' always best to use a variable for an object if possible
lastRow = ws.Cells(100000, 1).End(xlUp).Row ' work out how many rows to loop through
arr = ws.Range("A1:B" & lastRow).Value
For x = 1 To lastRow ' use a for loop to iterate over each row
If arr(x, 1) = ISO Then
foundCount = foundCount + 1
endString = endString & arr(x, 2) & vbNewLine ' add column B to the string
End If
Next x
End If
MsgBox "Found " & foundCount & " matches: " & vbNewLine & endString
End Sub

Answer 2

You could use Find and FindNext.
The first Test will return the values in a message box, the second will place the returned values in cell A1 on Sheet2.
I could've sworn this should work as a Worksheetfunction, but no luck (.FindNext won't work in a UDF).
Sub Test()
Dim MyMessage As String
MyMessage = ReturnCountAndValue("5", ThisWorkbook.Worksheets("Sheet1").Columns(1))
MsgBox MyMessage, vbOKOnly + vbInformation
End Sub
Sub Test2()
With ThisWorkbook
.Worksheets("Sheet2").Range("A1") = ReturnCountAndValue(.Worksheets("Sheet1").Range("K2"), _
.Worksheets("Sheet1").Range("F2:F9"))
End With
End Sub
Public Function ReturnCountAndValue(SearchValue As String, _
SearchColumn As Range) As String
Dim rFound As Range
Dim sFirstAddress As String
Dim sTempReturn As String
Dim lCounter As Long
With SearchColumn
Set rFound = .Find(What:=SearchValue, LookIn:=xlValues, LookAt:=xlWhole)
If Not rFound Is Nothing Then
sFirstAddress = rFound.Address
Do
lCounter = lCounter + 1
sTempReturn = sTempReturn & rFound.Offset(, 1).Value & vbCr
Set rFound = .FindNext(rFound)
Loop While rFound.Address <> sFirstAddress
sTempReturn = lCounter & " items found. " & vbCr & _
sTempReturn
Else
sTempReturn = SearchValue & " not found in range " & SearchColumn.Address
End If
End With
ReturnCountAndValue = sTempReturn
End Function