Macro Slow After Using Filter

Hi all

My worksheet_change Macro is running smoothly, until I filter a data.
Even when I remove all filters, the macro will take a minute to run (whereas it is instantly otherwhise)

Anyone has any idea what the reason could be for this?

Private Sub Worksheet_Change(ByVal Target As Range)
 
Application.ScreenUpdating = False
Application.Calculation = xlManual
Application.EnableEvents = False
Application.StatusBar = False

  
    
 If Columns("A:A").ColumnWidth <> 13.5 Then Columns("A:A").ColumnWidth = 13.5
 If Columns("B:B").ColumnWidth <> 29.3 Then Columns("B:B").ColumnWidth = 29.3
 If Columns("C:C").ColumnWidth <> 11.3 Then Columns("C:C").ColumnWidth = 11.3
 If Columns("D:D").ColumnWidth <> 11.3 Then Columns("D:D").ColumnWidth = 11.3
 If Columns("E:E").ColumnWidth <> 17.1 Then Columns("E:E").ColumnWidth = 17.1
 If Columns("F:F").ColumnWidth <> 4.6 Then Columns("F:F").ColumnWidth = 4.6
 If Columns("G:G").ColumnWidth <> 5.1 Then Columns("G:G").ColumnWidth = 5.1
 If Columns("H:H").ColumnWidth <> 3.3 Then Columns("H:H").ColumnWidth = 3.3
 If Columns("I:I").ColumnWidth <> 42.1 Then Columns("I:I").ColumnWidth = 42.1
 If Columns("J:J").ColumnWidth <> 0 Then Columns("J:J").ColumnWidth = 0
 If Columns("K:K").ColumnWidth <> 0 Then Columns("K:K").ColumnWidth = 0
 If Columns("L:L").ColumnWidth <> 17.9 Then Columns("L:L").ColumnWidth = 17.9
 If Columns("M:M").ColumnWidth <> 19.3 Then Columns("M:M").ColumnWidth = 19.3
 If Columns("N:N").ColumnWidth <> 7.5 Then Columns("N:N").ColumnWidth = 7.5
 If Columns("O:O").ColumnWidth <> 56.5 Then Columns("O:O").ColumnWidth = 56.5
 If Columns("P:P").ColumnWidth <> 13.3 Then Columns("P:P").ColumnWidth = 13.3
 If Columns("Q:Q").ColumnWidth <> 2 Then Columns("Q:Q").ColumnWidth = 2
 
 
 
 
 
  
Dim lr As Long
Dim i As Long
Dim a As Long
lr = Range("C" & Rows.Count).End(xlUp).Row

For i = 6 To lr
        
 With Range("C" & i)
    If Range("A2").Value - .Value > 5 And .Value <> "" Then .Offset(0, 13).Value = "COMMENT"
    If Range("A2").Value - .Value <= 5 And .Value <> "" Then .Offset(0, 13).Value = "OK"
 End With
   
 
With Range("O" & i)
    If .Value <> "" And 5 > Range("A2") - .Offset(0, -12) Then .Offset(0, 1).Value = "IN PROG. 5>"
    If .Value <> "" And 5 < Range("A2") - .Offset(0, -12) Then .Offset(0, 1).Value = "IN PROG. 5<"
    If .Value = "" And .Offset(0, -1) = "" Then .Offset(0, 1).Value = ""
    If .MergeCells Then 'check to see if the cell is part of a merged area
        .Offset(0, 1).Value = .MergeArea.Cells(1).Offset(0, 1)
    End If
End With

    
With Range("O" & i)
If Rows(i).Height > 0 Then
    If .MergeCells = False Then .EntireRow.AutoFit
       If .MergeCells = False And .Value <> "" Then .RowHeight = .Height + 15
    If .RowHeight < 12.75 Then .RowHeight = 12.75
End If
 End With


 With Range("E" & i + 1)
    .NumberFormatLocal = "_(* #'##0.00_);_(* (#'##0.00);_(* ""-""??_);_(@_)"
 End With


 With Range("B" & i + 1)
    .Style = "comma"
 End With


 
 Next i

  
Application.EnableEvents = True

  
With Range("O:O")
Dim NewRwHt As Single
Dim c As Range
Dim cc As Range
Dim r As Integer
Dim ma As Range
With Target
If .MergeCells And .WrapText Then
Set c = Target.Cells(1, 1)
Set ma = c.MergeArea
r = c.MergeArea.Rows.Count
For Each cc In ma.Cells
Next

On Error GoTo 0
ma.MergeCells = False
c.EntireRow.AutoFit
NewRwHt = c.RowHeight + 10
ma.MergeCells = True
If NewRwHt < 12.75 Then NewRwHt = 12.75 Else NewRwHt = NewRwHt / r
If NewRwHt < 12.75 Then NewRwHt = 12.75
ma.RowHeight = NewRwHt
End If
End With
End With
Application.EnableEvents = False

With Range("A3")
Rows("3:3").Hidden = .Value <> "YOU HAVE NOT ADJUSTED THE AS OF DATE"
End With

If GetSystemMetrics32(0) = 1920 And GetSystemMetrics32(1) = 1200 Then ActiveWindow.Zoom = 100 Else ActiveWindow.Zoom = 89



  With UsedRange
  .Font.Name = "Palatino"
  .VerticalAlignment = xlCenter
  End With


Application.Calculation = xlAutomatic
Application.EnableEvents = True
Application.StatusBar = True
Application.ScreenUpdating = True
  
  End Sub

I am afraid I cannot share a sample workbook

Hi Sixthsense

I just changed the part about col. width to

For i = 1 To 16
    If Columns(i).ColumnWidth <> vClWidth(i - 1) Then Columns(i).ColumnWidth = vClWidth(i - 1)
Next i

HI

Many thanks for your help.

Yes, there's no filter set in the code. It's only on the worksheet.
The thing is when I filter by "abc" (or whatever I filter by), then unfilter, the macro takes ages to run - I don't understand how it could have a influence on the code

Hi there

Are you referring to the macro running slow after filtering?

Hi sixthsense

No success by removing it

However, I spotted the part which makes it so slow after filtering - is there a way to improve the coding of this?

For i = 6 To lr
    With Range("C" & i)
       If Range("A2").Value - .Value > 5 And .Value <> "" Then .Offset(0, 13).Value = "COMMENT"
       If Range("A2").Value - .Value <= 5 And .Value <> "" Then .Offset(0, 13).Value = "OK"
    End With
    With Range("O" & i)
        If .Value <> "" And 5 > Range("A2") - .Offset(0, -12) Then .Offset(0, 1).Value = "IN PROG. 5>"
        If .Value <> "" And 5 < Range("A2") - .Offset(0, -12) Then .Offset(0, 1).Value = "IN PROG. 5<"
        If .Value = "" And .Offset(0, -1) = "" Then .Offset(0, 1).Value = ""
Next i

Thanks

FD