Could you check & advise on my code please

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
3,793
Office Version
  1. 2007
Platform
  1. Windows
Morning,
I use the code below to check a column for key words.
It works fine but ive noticed that when the code is run i see the worksheet in the background flickering.

Can you advise what ive done wrong to make this happen or advise please how to stop it.

Thanks

Rich (BB code):
Private Function add_val(a As String)

      Dim r As Range, f As Range, cell As String, added As Boolean
      Dim sh As Worksheet
      
      Set sh = Sheets("POSTAGE")
      sh.Select
      With ListBox1
        
        .ColumnCount = 4
        .ColumnWidths = "150;230;100;10"

        Set r = Range("G8", Range("G" & Rows.Count).End(xlUp))
        
        Set f = r.Find(a, 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                 'DATE RECEIVED
              .List(i, 1) = f.Offset(, -5).Value  'NAME
              .List(i, 2) = f.Offset(, -6).Value  'DATE
              .List(i, 3) = f.Row                 'ROW
              added = True
              Exit For
          End Select

            Next
            If added = False Then
          .AddItem f.Value                                 'DATE RECEIVED
          .List(.ListCount - 1, 1) = f.Offset(, -5).Value  'NAME
          .List(.ListCount - 1, 2) = f.Offset(, -6).Value  'DATE
          .List(.ListCount - 1, 3) = f.Row                 'ROW
        End If

            Set f = r.FindNext(f)
          Loop While Not f Is Nothing And f.Address <> cell
          ComboBox1 = UCase(ComboBox1)
          .TopIndex = 0
        Else
          MsgBox "NO CUSTOMER WAS FOUND USING THAT INFORMATION", vbCritical, "POSTAGE SHEET CUSTOMER NAME SEARCH"
          ComboBox1.Value = ""
          .SetFocus
        End If
      End With
  
End Function
Private Sub UserForm_Initialize()

Call add_val("LOST")
Call add_val("RECEIVED NO DATE")
Call add_val("RETURNED")
Call add_val("UNKNOWN")
End Sub
 

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
3,793
Office Version
  1. 2007
Platform
  1. Windows
Morning,
Yes that worked & now no flickering.
BUT
I had to remove the line of code shown below as once one of the search words wasnt found it then popped up the Msgbox.

Rich (BB code):
If ListBox1.ListCount = 0 Then

MsgBox "NO POSTAL ISSUES WERE FOUND", vbCritical, "POSTAL ISSUE CHECK LIST MESSAGE"

End If

This is now the code in use shown below
So i need to apply some code so when none of the search words are found then show Msgbox advising this.



Rich (BB code):
Private Function add_val(a As String)

      Dim r As Range, f As Range, cell As String, added As Boolean
      Dim sh As Worksheet
      
      Set sh = Sheets("POSTAGE")
      sh.Select
      With ListBox1
        
        .ColumnCount = 4
        .ColumnWidths = "180;230;250;10"

        Set r = Range("G8", Range("G" & Rows.Count).End(xlUp))
        
        Set f = r.Find(a, 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                 'POSTAL ISSUE COLUMN
              .List(i, 1) = f.Offset(, -5).Value  'NAME
              .List(i, 2) = f.Offset(, -4).Value  'ITEM
              .List(i, 3) = f.Offset(, -6).Value  'DATE
              .List(i, 4) = f.Row                 'ROW
              added = True
              Exit For
          End Select

            Next
            If added = False Then
          .AddItem f.Value                                 'POSTAL ISSUE COLUMN
          .List(.ListCount - 1, 1) = f.Offset(, -5).Value  'NAME
          .List(.ListCount - 1, 2) = f.Offset(, -4).Value  'NAME
          .List(.ListCount - 1, 3) = f.Offset(, -6).Value  'DATE
          .List(.ListCount - 1, 4) = f.Row                 'ROW
        End If

            Set f = r.FindNext(f)
          Loop While Not f Is Nothing And f.Address <> cell
        Else
        End If
      End With
End Function

Private Sub UserForm_Initialize()

Application.ScreenUpdating = False

On Error GoTo End_here

Call add_val("LOST")
Call add_val("RECEIVED NO DATE")
Call add_val("RETURNED")
Call add_val("UNKNOWN")

End_here: Application.ScreenUpdating = True
End Sub
 

Some videos you may like

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college

Watch MrExcel Video

Forum statistics

Threads
1,119,020
Messages
5,575,610
Members
412,679
Latest member
TSpan
Top