Could you check & advise on my code please

[ipbr21054]

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

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

 

[sykes]

You could try switching off screen updating...
Untested, so test on a COPY of your work, first.

Private Function add_val(a As String)

      Dim r As Range, f As Range, cell As String, added As Boolean
      Dim sh As Worksheet
      
Application.ScreenUpdating = False
On Error GoTo End_here
      
      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_here: Application.ScreenUpdating = True
End Function

 

[ipbr21054]

Thanks,

This is now in place,i assume you only added the lines as shown in Bold correct ?
Just checking as it still flickers,i noticed that the command buttons on the worksheet also flicker.

Private Function add_val(a As String)

      Dim r As Range, f As Range, cell As String, added As Boolean
      Dim sh As Worksheet
      
      Application.ScreenUpdating = False
      On Error GoTo End_here
      
      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_here:   Application.ScreenUpdating = True
End Function

 

[ipbr21054]

Hi,
Changing this to False works without the flicker but then what isnt it doing ?

End_here:   Application.ScreenUpdating = False

 

[sykes]

i assume you only added the lines as shown in Bold correct ?

Correct.

Not sure where else to go; I notice that this is a function - perhaps the calling code is part of a worksheet_change event, and the change is causing a long loop?

 

[ipbr21054]

Ok
So with that set to False then once the values are in the Listbox selecting one doesnt take you to that row on the worksheet.
True allows me to select a value & be taken to that value on the worksheet.

 

[sykes]

...we crossed each other, there...

In SOME cases, not resetting screenupdating to True at the end of code, will leave screenupdating in this condition (i.e. False) - which means that changes may be being made to your worksheet(s) but you may not SEE these changes.
My guess is, that this function is being called from another procedure, and that it's probably in this other procedure that the screenupdating needs switching off & on again.

 

[ipbr21054]

It works like this.

Run the code.
Check a column for specific words.
Code finds specific words & puts then in the Listbox.
I then select a result / value from the Listbox.
Userform closes & the item i selected from the Listbox is now selected on the worksheet.

Nothing changes at all.

So only specific words are listed.
I then look at a small list of values in the Listbox as opposed to 2000 entries etc on worksheet.
I select a value & im then taken there.

This just saves me time by looking down the column from say Row 1 untill i find the one im looking for.

 

[ipbr21054]

I think but not sure but the flickering is caused by the code looking for the first search word then once at bottom of column start with second then third etc etc ?

 

[sykes]

Just one more thought, before I've run out of ideas...

As before - test on a COPY of your work, first.

As the function's calling procedure, is the userform's _initialize event, I wonder whether putting the screenupdating calls into the calling procedure, instead, would work:

Can you try setting your Function back to it's original state (i.e. removing my suggested changes), and putting those lines into your initialize event instead, thus:

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