Could you check & advise on my code please

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,226
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
 
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
 
Upvote 0

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.

Forum statistics

Threads
1,214,827
Messages
6,121,823
Members
449,049
Latest member
cybersurfer5000

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top