Search worksheet for specific word then populate Listbox

[ipbr21054]

Morning,
I have a userform which when i select CheckBox1 i would like the code to search column G on my worksheet for the word YES then populate my ListBox with the required info.
I have the code below for which im using & follows my other codes on this form but im confused on how to set the word YES as the CheckBox1 value so the code knows what to search for when the user selecyts the CheckBox.

Thanks

Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then
  Dim r As Range, f As Range, cell As String, added As Boolean
  Dim sh As Worksheet
  
  Set sh = Sheets("DETAILS")
  sh.Select
  With ListBox1
    .Clear
    .ColumnCount = 3
    .ColumnWidths = "100;100;100"
    If CheckBox1.Value = "" Then Exit Sub
    Set r = Range("G3", Range("G" & Rows.Count).End(xlUp))
    Set f = r.Find(CheckBox1.Value, LookIn:=xlValues, lookat:=xlPart)
    If Not f Is Nothing Then
      cell = f.Address
      Do
        added = False
        For i = 0 To .ListCount - 1
          Select Case StrComp(.List(i), f.Value, vbTextCompare)
            Case 0, 1
              .AddItem f.Value, i
              .List(i, 1) = f.Row
              added = True
              Exit For
          End Select
        Next
           If added = False Then
          .AddItem f.Value
          .List(.ListCount - 1, 1) = f.Row
          .List(i, 1) = f.Offset(, 1).Value
          .List(i, 2) = f.Offset(, 2).Value
            added = True
            Exit For
          End Select
        Next
        If added = False Then
          .AddItem f.Value
          .List(.ListCount - 1, 1) = f.Offset(, 1).Value
          .List(.ListCount - 1, 2) = f.Offset(, 2).Value
        End If
        Set f = r.FindNext(f)
      Loop While Not f Is Nothing And f.Address <> cell
      .TopIndex = 0
      Else
      MsgBox "NO CUSTOMER WAS FOUND", vbCritical, "CLONING INFORMATION MESSAGE"
      CheckBox1.Value = ""
    End If
  End With
End Sub

 

[ipbr21054]

Sorry for my mistake above BUT this is the code in use
Thanks

Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then
  Dim r As Range, f As Range, cell As String, added As Boolean
  Dim sh As Worksheet
  
  Set sh = Sheets("DETAILS")
  sh.Select
  With ListBox1
    .Clear
    .ColumnCount = 3
    .ColumnWidths = "100;100;100"
    If CheckBox1.Value = "" Then Exit Sub
    Set r = Range("G3", Range("G" & Rows.Count).End(xlUp))
    Set f = r.Find(CheckBox1.Value, LookIn:=xlValues, lookat:=xlPart)
    If Not f Is Nothing Then
      cell = f.Address
      Do
        added = False
        For i = 0 To .ListCount - 1
          Select Case StrComp(.List(i), f.Value, vbTextCompare)
            Case 0, 1
              .AddItem f.Value, i
          .List(.ListCount - 1, 1) = f.Row
          .List(i, 1) = f.Offset(, 1).Value
          .List(i, 2) = f.Offset(, 2).Value
            added = True
            Exit For
          End Select
        Next
        If added = False Then
          .AddItem f.Value
          .List(.ListCount - 1, 1) = f.Offset(, 1).Value
          .List(.ListCount - 1, 2) = f.Offset(, 2).Value
        End If
        Set f = r.FindNext(f)
      Loop While Not f Is Nothing And f.Address <> cell
      .TopIndex = 0
      Else
      MsgBox "NO SNIFF DATA WAS FOUND", vbCritical, "CLONING INFORMATION MESSAGE"
      CheckBox1.Value = ""
    End If
  End With
  End If
End Sub

 

[dmt32]

Hi,
untested but see if this update to your code does what you want

Private Sub CheckBox1_Click()
    Dim FoundCell       As Range
    Dim i               As Long
    Dim FirstAddress    As String, Search As String
    Dim sh              As Worksheet
  
    Search = "Yes"
  
    Set sh = ThisWorkbook.Worksheets("DETAILS")
  
    With Me.ListBox1
        .Clear
        .ColumnCount = 4
        .ColumnWidths = "100;100;100;0"
      
        If Not Me.CheckBox1.Value Then Exit Sub
      
        Set FoundCell = sh.Columns(7).Find(Search, LookIn:=xlValues, lookat:=xlPart)
        If Not FoundCell Is Nothing Then
            FirstAddress = FoundCell.Address
            Do
                .AddItem FoundCell.Value, i
                .List(i, 1) = FoundCell.Offset(, 1).Value
                .List(i, 2) = FoundCell.Offset(, 2).Value
              
                'record row (hidden)
                .List(i, 3) = FoundCell.Row
              
                i = i + 1
              
                Set FoundCell = sh.Columns(7).FindNext(FoundCell)
                If FoundCell Is Nothing Then Exit Do
              
            Loop While FoundCell.Address <> FirstAddress
          
        Else
            MsgBox "NO SNIFF DATA WAS FOUND", vbCritical, "CLONING INFORMATION MESSAGE"
            Me.CheckBox1.Value = False
        End If
    End With
End Sub

Dave

 

[ipbr21054]

Thanks for the reply.
I would like to keep the code similair to what i have for the other textboxes so i can then follow one code.
I managed to sort it by adding the word YES like so

Set f = r.Find("YES", LookIn:=xlValues, lookat:=xlPart)