how to use "For each" loop in vba? - vba

Question

Sub Findnext()
Dim Name As String
Dim f As range
Dim ws As Worksheet
Dim s As Integer
Name = surname.Value
'currently only searching one instance...doesn't loop and find the rest
Me.ListBox1.Clear
Set f = Cells.Find(what:=Name, LookIn:=xlValues)
Set findnext = f
With ListBox1
Do
Debug.Print findnext.Address
Set findnext = Cells.findnext(findnext)
.AddItem f.Value
.List(0, 1) = f.Offset(0, 1).Value
.List(0, 2) = f.Offset(0, 2).Value
.List(0, 3) = f.Offset(0, 3).Value
.List(0, 4) = f.Offset(0, 4).Value
.List(0, 5) = f.Offset(0, 5).Value
.List(0, 6) = f.Offset(0, 6).Value
Loop While findnext.Address <> f.Address
End With
End Sub
how do i make this code loop so that it would find multiple f values? essentailly, I have a search button and it promopts "There are 3 instances" and in the list box, it should list out the 3 instances (eg. same name).
I tried using For each f and next f in the code above, but it still only picks one f.value and doesn't pick any other cells with same name....
EDIT:
i've added the loop function but now in the list box, it only lists the person's name instead of listing all the offset values. is the offset not applied to the loop? or is it because it's only looking for f? which is the name it's looking for?
EDIT: The coding I have done so far...
Private Sub CommandButton1_Click()
MsgBox "Directorate has been added", vbOKOnly
Dim ctrl As control
For Each ctrl In UserForm1.Controls
If TypeName(ctrl) = "CheckBox" Then
'Pass this CheckBox to the subroutine below:
TransferValues ctrl
End If
Next
TransferMasterValue
End Sub
Sub TransferValues(cb As MSForms.CheckBox)
Dim ws As Worksheet
Dim emptyRow As Long
If cb Then
'Define the worksheet based on the CheckBox.Name property:
Set ws = Sheets(Left(cb.Name, 15))
emptyRow = WorksheetFunction.CountA(ws.range("A:A")) + 1
With ws
.Cells(emptyRow, 1).Value = surname.Value
.Cells(emptyRow, 2).Value = firstname.Value
.Cells(emptyRow, 3).Value = tod.Value
.Cells(emptyRow, 4).Value = program.Value
.Cells(emptyRow, 5).Value = email.Value
.Cells(emptyRow, 6).Value = officenumber.Value
.Cells(emptyRow, 7).Value = cellnumber.Value
End With
End If
End Sub
Sub TransferMasterValue()
Dim allChecks As String
Dim ws As Worksheet
'Iterate through the checkboxes concatenating a string of all names
For Each ctrl In UserForm1.Controls
If TypeName(ctrl) = "CheckBox" Then
If ctrl Then
allChecks = allChecks & ctrl.Name & ""
End If
End If
Next
'If you have at least one transfer to the Master sheet
If Len(allChecks) > 0 Then
Set ws1 = Sheets("Master")
emptyRow = WorksheetFunction.CountA(range("A:A")) + 1
With ws1
.Cells(emptyRow, 1).Value = surname.Value
.Cells(emptyRow, 2).Value = firstname.Value
.Cells(emptyRow, 3).Value = tod.Value
.Cells(emptyRow, 4).Value = program.Value
.Cells(emptyRow, 5).Value = email.Value
.Cells(emptyRow, 7).Value = officenumber.Value
.Cells(emptyRow, 8).Value = cellnumber.Value
.Cells(emptyRow, 6).Value = Left(allChecks, Len(allChecks) - 1)
End With
End If
End Sub
Private Sub CommandButton2_Click()
Unload UserForm1
End Sub
Private Sub CommandButton3_Click()
surname.Value = ""
firstname.Value = ""
tod.Value = ""
program.Value = ""
email.Value = ""
officenumber.Value = ""
cellnumber.Value = ""
PACT.Value = False
PrinceRupert.Value = False
WPM.Value = False
Montreal.Value = False
TET.Value = False
TC.Value = False
US.Value = False
Other.Value = False
End Sub
Private Sub ListBox1_Click()
Dim r As Long
With Me.ListBox1
With Me
.surname.Value = .ListBox1.List(.ListBox1.ListIndex, 0)
.firstname.Value = .ListBox1.List(.ListBox1.ListIndex, 1)
.tod.Value = .ListBox1.List(.ListBox1.ListIndex, 2)
.program.Value = .ListBox1.List(.ListBox1.ListIndex, 3)
.email.Value = .ListBox1.List(.ListBox1.ListIndex, 4)
.officenumber.Value = .ListBox1.List(.ListBox1.ListIndex, 5)
.cellnumber.Value = .ListBox1.List(.ListBox1.ListIndex, 6)
End With
End With
End Sub
Private Sub Search_Click() 'only searches in master tab right now need to search from all worksheets
Dim Name As String
Dim f As range
Dim r As Long
Dim ws As Worksheet
Dim s As Integer
Dim FirstAddress As String
Name = surname.Value
With ws
Set f = range("A:A").Find(what:=Name, LookIn:=xlValues)
If Not f Is Nothing Then
With Me
firstname.Value = f.Offset(0, 1).Value
tod.Value = f.Offset(0, 2).Value
program.Value = f.Offset(0, 3).Value
email.Value = f.Offset(0, 4).Text
officenumber.Value = f.Offset(0, 5).Text
cellnumber.Value = f.Offset(0, 6).Text
End With
findnext
FirstAddress = f.Address
Do
s = s + 1
Set f = range("A:A").findnext(f)
Loop While Not f Is Nothing And f.Address <> FirstAddress
If s > 1 Then
Select Case MsgBox("There are " & s & " instances of " & Name, vbOKCancel Or vbExclamation Or vbDefaultButton1, "Multiple entries")
Case vbOK
findnext
Case vbCancel
End Select
End If
Else: MsgBox Name & "Not Listed"
End If
End With
End Sub
Sub findnext()
Dim Name As String
Dim f As range
Dim ws As Worksheet
Dim s As Integer
Dim findnext As range
Name = surname.Value
Me.ListBox1.Clear
Set f = range("A:A").Find(what:=Name, LookIn:=xlValues)
Set findnext = f
With ListBox1
Do
Debug.Print findnext.Address
Set findnext = range("A:A").findnext(findnext)
.AddItem findnext.Value
.List(0, 1) = findnext.Offset(0, 1).Value
.List(0, 2) = findnext.Offset(0, 2).Value
.List(0, 3) = findnext.Offset(0, 3).Value
.List(0, 4) = findnext.Offset(0, 4).Value
.List(0, 5) = findnext.Offset(0, 5).Value
.List(0, 6) = findnext.Offset(0, 6).Value
.List(0, 7) = findnext.Offset(0, 6).Value
Loop While findnext.Address <> f.Address
End With
End Sub

Answer 1

You need to you Find then FindNext in a loop. You know you are done looping when your FindNext finds the very first thing you found again. It will cycle like that.
Dim firstFind As Range, subsequentFinds As Range
Set firstFind = Range("D3:D500").Find("search string", , xlValues)
Set subsequentFinds = firstFind
Do
Debug.Print subsequentFinds.Address
Set subsequentFinds = Cells.FindNext(subsequentFinds)
Loop While subsequentFinds.Address <> firstFind.Address