Based on a tutorial I've created a little contact manager in Excel and made some adjustments for my own purpose. So far so good and a nice little experience for me as a VBA-noob:)
A bit of background information
I've got two sheets. The first one contains people and their address. The second contains all their contactdetails (to prevent having infinite columns on the first sheet for different phones, mails etc). The details are matched based upon the ID of the data in the first sheet and presented in two listboxes. The search value is stored in C5. C4 references to the column for a specific type of data (like Name, Address, Place) and is empty when I want to search all columns.
The issue
When I try to search for something it only returns the first item found and stops. I guess I need to create a loop to get all items but so far I've not succeeded in creating a functioning loop.
Code I have so far
Private Sub btnZoeken_Click()
'dim the variables
Dim Crit As Range
Dim FindMe As Range
Dim DataSH As Worksheet
On Error GoTo errHandler:
Set DataSH = Sheet1
Application.ScreenUpdating = False
'Default search criteria is Alles (all columns).
If Me.cboHeader.Value <> "Alles" Then
If Me.txtZoeken = "" Then
DataSH.Range("C5") = ""
Else
DataSH.Range("C5") = "*" & Me.txtZoeken.Value & "*"
End If
End If
'if all columns is selected
If Me.cboHeader.Value = "Alles" Then
'find the value in the column
Set FindMe = DataSH.Range("B9:H30000").Find(What:=txtZoeken, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
'variable for criteria header
Set Crit = DataSH.Cells(8, FindMe.Column)
'if no criteria is added to the search
If Me.txtZoeken = "" Then
DataSH.Range("C5") = ""
DataSH.Range("C4") = ""
Else
'add values from the search
DataSH.Range("C4") = Crit
If Crit = "ID" Then
DataSH.Range("C5") = Me.txtZoeken.Value
Else
DataSH.Range("C5") = "*" & Me.txtZoeken.Value & "*"
End If
End If
End If
'filter the data
DataSH.Range("B8").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("Data!$C$4:$C$5"), CopyToRange:=Range("Data!$N$8:$T$8"), _
Unique:=False
'add the dynamic data to the listbox
lstResult.RowSource = DataSH.Range("outdata").Address(external:=True)
'show which column contained to selected value (for now only for debugging)
Me.RegTreffer.Value = DataSH.Range("C4")
'error handler
On Error GoTo 0
Exit Sub
errHandler:
'if error occurs then show me exactly where the error occurs
MsgBox "No result for " & txtZoeken.Text & " in " & Me.cboHeader.Value
'clear the listbox if no match is found
Me.lstResult.RowSource = ""
Exit Sub
End Sub
How should I build a loop to get all the rows with a matching value in any column? And do I need to create two different loops? One for searching in all columns and one for searching specific columns or wouldn't it matter?
First, a direct answer to your question:
Private Sub LookForMatches()
' Set a reference to our range
Dim MyRange As Range
Set MyRange = ThisWorkbook.Sheets("Sheet1").Range("A1:C4")
' Loop through all of the cells in the range
Dim Cell As Variant
For Each Cell In MyRange.Cells
' In this example, we will check if the cell equals 1
' If it does, display a message informing the user of the match and the location of the cell
If Cell.Value = 1 Then
MsgBox "Match found. The cell " & Cell.Address & " equals 1."
End If
Next Cell
End Sub
Here is the data on Sheet1 used for my example.
Hopefully this template is enough of an example on how to loop through a range and look for information. If you are only interested in the row of the cell and not the full address you can use the Cell.Row
method instead of the Cell.Address
method.
Second, you typically shouldn't loop through data like this. It's much slower than other methods. For example, we could store this range in an array, and then work with the array rather than the range. But that's all outside the scope of your question. I hope this was helpful!
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.