Speed up 'brute force' macro

Question

Trying to speed up this macro, it just loops through 'C-L" columns and changes the format based on adjacent cell values.

Sub finalfinal3()
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Sheets("FBM").Activate
    
   Range("C4").Select
    If ActiveCell.Offset(-1, 0) = "Grand Total" Then
        ActiveCell.Offset(1, 0).Select
    Else
    
     Do Until ActiveCell.row = 500
    
       If ActiveCell.Offset(0, -1).Value = "OnOrder" Then
       ActiveCell.ClearFormats
       ActiveCell.Font.Color = RGB(255, 255, 255)
       
            ElseIf ActiveCell.Offset(0, -1).Value = "OnHand" Then
            ActiveCell.ClearFormats
            ActiveCell.Font.Color = RGB(0, 0, 0)
        
                Else
                ActiveCell.ClearFormats
                ActiveCell.Font.Color = RGB(217, 217, 217)

        End If
        
        ActiveCell.Offset(1, 0).Select
        
    Loop
    
  End If
      
    
     Range("D4").Select
      If ActiveCell.Offset(-1, 0) = "Grand Total" Then
        ActiveCell.Offset(1, 0).Select
      Else
      
       Do Until ActiveCell.row = 500
        
        If ActiveCell.Offset(0, -2).Value = "OnOrder" Then
        ActiveCell.ClearFormats
        ActiveCell.Font.Color = RGB(255, 255, 255)
        
            ElseIf ActiveCell.Offset(0, -2).Value = "OnHand" Then
            ActiveCell.ClearFormats
            ActiveCell.Font.Color = RGB(0, 0, 0)
                
                Else
                ActiveCell.ClearFormats
                ActiveCell.Font.Color = RGB(217, 217, 217)

      End If
        ActiveCell.Offset(1, 0).Select
    Loop
       
      End If
      
   Range("E4").Select
      If ActiveCell.Offset(-1, 0) = "Grand Total" Then
 ActiveCell.Offset(1, 0).Select
    Else
    Do Until ActiveCell.row = 500
   
     If ActiveCell.Offset(0, -3).Value = "OnOrder" Then
     ActiveCell.ClearFormats
      ActiveCell.Font.Color = RGB(255, 255, 255)
      ElseIf ActiveCell.Offset(0, -3).Value = "OnHand" Then
      ActiveCell.ClearFormats
     ActiveCell.Font.Color = RGB(0, 0, 0)
     Else
     ActiveCell.ClearFormats
     ActiveCell.Font.Color = RGB(217, 217, 217)

      End If
        ActiveCell.Offset(1, 0).Select
    Loop
    
        
      End If
      
   Range("F4").Select
      If ActiveCell.Offset(-1, 0) = "Grand Total" Then
 ActiveCell.Offset(1, 0).Select
    Else
    Do Until ActiveCell.row = 500
   
   If ActiveCell.Offset(0, -4).Value = "OnOrder" Then
   ActiveCell.ClearFormats
      ActiveCell.Font.Color = RGB(255, 255, 255)
      ElseIf ActiveCell.Offset(0, -4).Value = "OnHand" Then
      ActiveCell.ClearFormats
     ActiveCell.Font.Color = RGB(0, 0, 0)
     Else
     ActiveCell.ClearFormats
     ActiveCell.Font.Color = RGB(217, 217, 217)
      End If
        ActiveCell.Offset(1, 0).Select
    Loop
        
      End If
      
Range("G4").Select
      If ActiveCell.Offset(-1, 0) = "Grand Total" Then
 ActiveCell.Offset(1, 0).Select
    Else
    Do Until ActiveCell.row = 500
   
   If ActiveCell.Offset(0, -5).Value = "OnOrder" Then
   ActiveCell.ClearFormats
      ActiveCell.Font.Color = RGB(255, 255, 255)
      ElseIf ActiveCell.Offset(0, -5).Value = "OnHand" Then
      ActiveCell.ClearFormats
     ActiveCell.Font.Color = RGB(0, 0, 0)
     Else
     ActiveCell.ClearFormats
     ActiveCell.Font.Color = RGB(217, 217, 217)

      End If
        ActiveCell.Offset(1, 0).Select
    Loop
    
      End If
      
     Range("H4").Select
       If ActiveCell.Offset(-1, 0) = "Grand Total" Then
 ActiveCell.Offset(1, 0).Select
    Else
    Do Until ActiveCell.row = 500
   
   If ActiveCell.Offset(0, -6).Value = "OnOrder" Then
   ActiveCell.ClearFormats
      ActiveCell.Font.Color = RGB(255, 255, 255)
      ElseIf ActiveCell.Offset(0, -6).Value = "OnHand" Then
      ActiveCell.ClearFormats
     ActiveCell.Font.Color = RGB(0, 0, 0)
     Else
     ActiveCell.ClearFormats
     ActiveCell.Font.Color = RGB(217, 217, 217)
      End If
        ActiveCell.Offset(1, 0).Select
    Loop
    
      End If
      
      Range("I4").Select
        If ActiveCell.Offset(-1, 0) = "Grand Total" Then
 ActiveCell.Offset(1, 0).Select
    Else
    Do Until ActiveCell.row = 500
   
   If ActiveCell.Offset(0, -7).Value = "OnOrder" Then
   ActiveCell.ClearFormats
      ActiveCell.Font.Color = RGB(255, 255, 255)
      ElseIf ActiveCell.Offset(0, -7).Value = "OnHand" Then
      ActiveCell.ClearFormats
     ActiveCell.Font.Color = RGB(0, 0, 0)
     Else
     ActiveCell.ClearFormats
     ActiveCell.Font.Color = RGB(217, 217, 217)

      End If
        ActiveCell.Offset(1, 0).Select
    Loop
    
      End If
      
     Range("J4").Select
        If ActiveCell.Offset(-1, 0) = "Grand Total" Then
 ActiveCell.Offset(1, 0).Select
    Else
    Do Until ActiveCell.row = 500
   
   If ActiveCell.Offset(0, -8).Value = "OnOrder" Then
   ActiveCell.ClearFormats
      ActiveCell.Font.Color = RGB(255, 255, 255)
      ElseIf ActiveCell.Offset(0, -8).Value = "OnHand" Then
      ActiveCell.ClearFormats
     ActiveCell.Font.Color = RGB(0, 0, 0)
     Else
     ActiveCell.ClearFormats
     ActiveCell.Font.Color = RGB(217, 217, 217)

      End If
        ActiveCell.Offset(1, 0).Select
    Loop
    
      End If
      
      Range("K4").Select
        If ActiveCell.Offset(-1, 0) = "Grand Total" Then
 ActiveCell.Offset(1, 0).Select
    Else
    Do Until ActiveCell.row = 500
   
   If ActiveCell.Offset(0, -9).Value = "OnOrder" Then
   ActiveCell.ClearFormats
      ActiveCell.Font.Color = RGB(255, 255, 255)
      ElseIf ActiveCell.Offset(0, -9).Value = "OnHand" Then
      ActiveCell.ClearFormats
     ActiveCell.Font.Color = RGB(0, 0, 0)
     Else
     ActiveCell.ClearFormats
     ActiveCell.Font.Color = RGB(217, 217, 217)

      End If
        ActiveCell.Offset(1, 0).Select
    Loop
    
      End If
      
          Range("l4").Select
      If ActiveCell.Offset(-1, 0) = "Grand Total" Then
 ActiveCell.Offset(1, 0).Select
    Else
    Do Until ActiveCell.row = 500
   
   If ActiveCell.Offset(0, -10).Value = "OnOrder" Then
   ActiveCell.ClearFormats
      ActiveCell.Font.Color = RGB(255, 255, 255)
      ElseIf ActiveCell.Offset(0, -10).Value = "OnHand" Then
      ActiveCell.ClearFormats
     ActiveCell.Font.Color = RGB(0, 0, 0)
     Else
     ActiveCell.ClearFormats
     ActiveCell.Font.Color = RGB(217, 217, 217)

      End If
        ActiveCell.Offset(1, 0).Select
    Loop
    
      End If
      
  End Sub

This is better for [code review](https://codereview.stackexchange.com/). — findwindow, Sep 14 '22 at 22:01
holy moly, that is A_lot of lines for formatting. Based on a quick glance, I'm guessing the fastest way to do this would be to pull all relevant data into an array, check it all there while building a `Range()` of cells to format (using `Union` i believe). Finally applying that format to the entire range at once. — Cameron Critchlow, Sep 15 '22 at 01:13
If you don't want to completely rebuild it from scratch, try editing it by getting rid of `.Select` [LIKE THIS](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). I'd use a `For` loop, and only have 1 loop that does everything rather than 4 loops. — Cameron Critchlow, Sep 15 '22 at 01:16
Actually... What I would personally do is drop the VBA and get going on some complex "Conditional Formatting". I bet that could do what you need. — Cameron Critchlow, Sep 15 '22 at 01:17

Speed up 'brute force' macro

0 Answers0