So I have the following code below: and what i want to focus on is the Private Sub Search_Click(). Currently when I search someone's surname it populate the textboxes automatically. Is it possible to have a search box that populates the checkboxes automatically? so for example, if the person belongs to 6/8 checkboxes, and i click search 6/8 checkboxes would be checkmarked? and is it possible to do the same thing with ListBox1_Click()? so when i click on person's name from listbox, it also popoulates the checkbocxes automatically depending on which checkbox that person belongs to?
EDIT
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
For Each ws In ActiveWorkbook.Sheets
With ws
Set f = Range("A:A").Find(what:=Name, LookIn:=xlValues)
If Not f Is Nothing Then
If cb.Name = ws.Name Then
cb.Value = True
End If
Next
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
Is this what it would look like...? I can't get it to work though?
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
It doesnt seem like a coding problem, I saw the code where you set the textboxes text. Basically, instead of setting textboxes text, you'd be setting the checkbox. the code to to that is ChkCheck.value = true.
leave a comment if theres a deeper issue and ill make an edit
edit
To search all sheets,
I would put a loop in there like
for each ws in ActiveWorkbook.Sheets
and then put your search in there.
and then, after the if f is not nothing then
loop through all controls, and check to see if the controls name = the sheets name. -
if ctrl.name = ws.name then
ctrl.value = true
end if
like that
so then each time the sheets loop runs, if it finds the specific name, the checkbox accosiated with the particular sheet will check.
Related
I have been trying to get a simple task done in VBA; I am writing a GUI for an excel spreadsheet that is holding inventory. It enables users to input info into the GUI click ok and all of what they typed in is saved into the excel document.
However every time I run the below code I get a compiler error "Method or data not found".
Private Sub Label1_Click()
End Sub
Private Sub Label4_Click()
End Sub
Private Sub cmdAdd_Click()
'Copy input values to sheet.
Dim lRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Inventory")
lRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
With ws
.Cells(lRow, 1).Value = Me.AssetType.Value
.Cells(lRow, 2).Value = Me.AssetNumber.Value
.Cells(lRow, 4).Value = Me.Description.Value
.Cells(lRow, 5).Value = Me.SerialNbr.Value
.Cells(lRow, 6).Value = Me.CurrentUse.Value
.Cells(lRow, 7).Value = Me.DateRec.Value
.Cells(lRow, 8).Value = Me.FundingSource.Value
.Cells(lRow, 9).Value = Me.Manufacturer.Value
.Cells(lRow, 10).Value = Me.Model.Value
.Cells(lRow, 11).Value = Me.Contract.Value
.Cells(lRow, 12).Value = Me.Status.Value
.Cells(lRow, 13).Value = Me.Room.Value
.Cells(lRow, 14).Value = Me.OfficeLocation.Value
.Cells(lRow, 19).Value = Me.Custodian.Value
.Cells(lRow, 20).Value = Me.ExcessedDate.Value
.Cells(lRow, 21).Value = Me.ExcessAuthorization.Value
.Cells(lRow, 22).Value = Me.Comments.Value
.Cells(lRow, 23).Value = Me.OutDate.Value
End With
'Clear input controls.
Me.AssetType.Value = ""
Me.AssetNumber.Value = ""
Me.Description.Value = ""
Me.SerialNbr.Value = ""
Me.CurrentUse.Value = ""
Me.DateRec.Value = ""
Me.FundingSource.Value = ""
Me.Manufacturer.Value = ""
Me.Model.Value = ""
Me.Contract.Value = ""
Me.Status.Value = ""
Me.Room.Value = ""
Me.OfficeLocation.Value ""
Me.Custodian.Value ""
Me.ExcessedDate.Value ""
Me.ExcessAuthorization.Value ""
Me.Comments.Value ""
Me.OutDate.Value ""
End Sub
Private Sub cmdClose_Click()
'Close UserForm.
Unload Me
End Sub
Private Sub Cmdbutton_add_Click()
End Sub
Private Sub Model_Click()
End Sub
Private Sub UserForm_Click()
End Sub
Get the value of a text box by the .text property of the text box.
If your text box is named AssetType it would be
.Cells(lRow, 1).Value = AssetType.Text
You may need to use the form name.
.Cells(lRow, 1).Value = UserForm1.AssetType.Text
Hi I have the following code:
Private Sub Search_Click()
Dim Name As String
Dim f As Range
Dim r As Long
Dim ws As Worksheet
Dim s As Integer
Dim FirstAddress As String
Dim str() 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
SetCheckBoxes f.Offset(0, 5) '<<< replaces code below
officenumber.Value = f.Offset(0, 6).Text
cellnumber.Value = f.Offset(0, 7).Text
r = f.Row '<<<<<<<<< using this to locate the row of "found"
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
and i want to use an update button:
private Sub update_Click()
Dim Name As String
Dim f As Range
Dim ws As Worksheet
With ws
Set f = .Cells(r, 1) '<<<<<<<<<<<<< Mismatch type error
f.Value = surname.Value
f.Offset(0, 1).Value = firstname.Value
f.Offset(0, 2).Value = tod.Value
f.Offset(0, 3).Value = program.Value
f.Offset(0, 4).Value = email.Value
f.Offset(0, 5).Value = GetCheckBoxes
f.Offset(0, 6).Value = officenumber.Value
f.Offset(0, 7).Value = cellnumber.Value
End With
End Sub
so i want to locate the row of the found cell and replace all the cells to whatever is written in the textbox (updating the previous infomration with new information) - however i get an error on set f = .cells(r,1) how can i fix this?
Try to use global variable r: instead declaring Dim r As Long in Private Sub Search_Click(), use Public r As Long outside all functions in the very top of module :
Public r As Long
Public Sub Search_Click()
'your code
End Sub
Public Sub update_Click()
'your code
End Sub
Now, after calling Search_Click r would be inizialized and then you could call update_Click.
P.S. Don't forget to remove Dim r As Long from Private Sub Search_Click().
BTW, in your update_Click and Search_Click subs you haven't initialized ws variable: Set ws = ThisWorkbook.Worksheets("Sheet1"). After adding this line change Range("A:A") to .Range("A:A") in Search_Click
i want have an add command and a search command. i thought if i reciprocate the add command then i can use it as a search command but it gives an invalid procedure call or argument.
add command:
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
Search Command:
Private Sub Search_Click()
Dim Name As String
Dim f As Range
Dim r As Long
Dim ws As Worksheet
Dim s As Integer
Dim FirstAddress As String
Dim ctrl As control
Dim allchecks As String
For Each ctrl In UserForm1.Controls
If TypeName(ctrl) = "CheckBox" Then
If ctrl.value = true Then
allchecks = allchecks & ctrl.Name & " "
End If
End If
Next
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, 6).Text
cellnumber.Value = f.Offset(0, 7).Text
EDIT:
If Len(allchekcs)>0 then
If f.Offset(0, 5).Value = Left(allchecks, Len(allchecks) - 1) Then ctrl.Value = True
end if
EDIT: so i've added the if Len(allchecks)>0 then command, and it doesn't give error 5 but it still doesn't checkmark the userform checkboxes - how can i fix this? right now when the information is added to column 6, it's added as "Montreal Ottawa Toronto Vancouver" and perhaps that's why it's not picking it up? because there's multiple checkbox names in one cell? in order for ctrl.value = true to work the cell value has to equal to one ctrl.name? is there a way i can separate so it picks up using ctrl?
To separate the values in the cell, use the Split command:
For each ctrl in UserForm1.Controls
For i = 0 to UBound(Split(CellValue," "))
If Split(CellValue, " ")(i) = ctrl.Name Then ctrl.Value = True
Next i
Next
Where CellValue is the Value of the cell that contains the allchecks value.
Private Sub CommandButton1_Click()
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
End Sub
Sub TransferValues(cb As MSForms.CheckBox)
Dim ws As Worksheet
Dim emptyRow As Long
Dim ws1 As Worksheet
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
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, 6).Value = officenumber.Value
.Cells(emptyRow, 7).Value = cellnumber.Value
.Cells(emptyRow, 8).Value = cb.Name
End With
End If
'the master sheet needs to have a "Stakeholder" column with list of stakeholder the person belongs to
The problem here is Cb.Name - I want the name checkboxes to appear in one single cell but right now it's making extra rows depending on the number of checked boxes. So instead of putting 6/8 checked boxes names into 1 single cell it makes 6 rows with each names which is not good. How do i transfer all cb.names into one single cell?
sorry if the code doesn't look properly formatted - for some reason it's not showing all the indents...
If I read you right your transfer function deals with individual checks but the master sheet needs to have a single line for the whole lot, right?
If so what you will need to do is work on the individual and collective levels separately. Delete all references to the master sheet from your basic sub and deal with the master sheet on it's own
Sub TransferMasterValue()
Dim allChecks As String
'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
'Your code to transfer
Set ws1 = Sheets("Master")
emptyRow = WorksheetFunction.CountA(range("A:A")) + 1
With ws1
.Cells(emptyRow, 1).Value = surname.Value
...
'and post the concatenated value in the name position
.Cells(emptyRow, 8).Value = left(allChecks,len(allChecks)-1)
End With
End If
End Sub
The main button click function will then look like...
Private Sub CommandButton1_Click()
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
Have you tried concatenate? If I have cells |1|2|3|4|5| I can just insert the function =CONCATENATE(A1,",",B1) and you can change to "," to " " for a space, or have no separation at all. If this isn't what you're looking for then I think I misinterpted the 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
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