Efficient formatting of specific cells by looping through...

[ChloeLM]

Hello everyone

I'm a VBA novice who has muddled through a piece of code and got it working. However it's very long (and slow!) and i'm looking for some advice on how to make it more elegant (and efficient!) in order to speed up my procedure. Am i using an efficient way to loop through the procedure? Is there a more efficient way to refer to the range other than guessing what the maximum range might be (I tried to incorporate Range("A4:A4").End(xlDown) unsuccessfully)? Is there an optimal order to ask it to do things in which speeds things up?

I have a financial profit and loss spreadsheet where column A contains row headings/sub headings, and column B:E contains corresponding numbers - one financial year in each column. It is normally between 120 and 500 rows long. The spreadsheet is a CSV which is exported from another system, some of the layout is predictable, some is different each time. In particular the main row headings/totals have predictable text, while the rows in between are variable. I need to format the predictable rows.

E.g. In column A there are 64 possible main row headings that might appear (they are not all used each time). These are predictable and I have defined them as constants in the declarations section e.g. Const myLabel7="Staff Costs" and so on for all 64. I then have subheadings under these that have numbers adjacent to them, and where the text in column A is always different. For example, underneath Staff Costs I could have any number of variations - 'paid labour', 'salaries' all of which do have corresponding number amounts. There are also 64 possible 'total' headings that might appear, which correspond to the main row headings e.g. 'Staff Costs Total'. Again i've defined them as constants in the declarations section e.g. Const myLabelTotal7="Staff Costs Total"

In the first draft of my VBA programme I have managed to get it to format the rows in the way that I want but it's slow. I have used the code below (which shows the first 2 blocks, there are another 126 blocks like this), and it is looking for particular text, deciding what type of heading it is based on whether there are adjacent numbers, and formatting it accordingly (i have 5 different versions of the row format e.g. myHeight, myHeight1, myHeight2 - and corresponding myTint, myItalics etc):

Sub FormatHeadingsMyLabels()


'Looks for text and highlights the entire row.

Range("A1").Activate

             
      For Each cell In Range("A4:A500")
  '***VARIABLE1***
    If InStr((cell.Value), myLabel1) <> 0 Then    'if cell name *contains* then do something
  '***VARIABLE1***
    cell.Offset(0, 5).Activate                          'go 5 cells to the right
    Select Case IsEmpty(ActiveCell)                     'is this cell empty?
        Case False                                      'no   [ignore?]
        Case True                                       'yes - the do the thing on the next line
        ActiveCell.Offset(0, 1).Activate              'activate the next cell along
        ActiveCell = 1                                'and put 1 in it
        ActiveCell.EntireRow.Select
    Selection.Font.Italic = myitalics                  'make it italic
         Selection.RowHeight = myHeight                 'change the row height
         Selection.Font.Bold = myBold                   'make the row bold
             With Selection.Font                         'change the row font and colour
              .ThemeColor = mycolour
              .TintAndShade = mytint
              .Size = mySize
            End With
            With Selection
            .AddIndent = True
            .IndentLevel = myindent
            End With
        End Select
                                            
    End If
    Next
   
    For Each cell In Range("A4:A500")
  '***VARIABLE2***
    If InStr((cell.Value), myLabel2) <> 0 Then    'if cell name *contains* then do something
  '***VARIABLE2***
    cell.Offset(0, 5).Activate                          'go 5 cells to the right
    Select Case IsEmpty(ActiveCell)                     'is this cell empty?
        Case False                                      'no   [ignore?]
        Case True
        ActiveCell.Offset(0, 1).Activate              'activate the next cell along
        ActiveCell = 1                                'and put 1 in it
                                                        'yes - the do the thing on the next line
        ActiveCell.EntireRow.Select
    Selection.Font.Italic = myitalics                  'make it italic
         Selection.RowHeight = myHeight                 'change the row height
         Selection.Font.Bold = myBold                   'make the row bold
             With Selection.Font                         'change the row font and colour
              .ThemeColor = mycolour
              .TintAndShade = mytint
              .Size = mySize
            End With
             With Selection
            .AddIndent = True
            .IndentLevel = myindent
            End With
        End Select
                                            
    End If
    Next

All advice appreciated!

Cheers
Chloe

 

[Fluff]

You could do something like this

Sub FormatHeadingsMyLabels()
   
   For Each cell In Range("A4:A500")
      '***VARIABLE1***
      If InStr(1, cell.Value, myLabel1) > 0 Or InStr(1, cell.Value, myLabel2) > 0 Then  'if cell name *contains* then do something
         If cell.Offset(0, 5).Value = "" Then                        'go 5 cells to the right
            cell.Offset(0, 6).Value = 1            'activate the next cell along
            With cell.EntireRow
               .RowHeight = myHeight                 'change the row height
               With .Font                         'change the row font and colour
                  .Italic = myitalics
                  .Bold = mybold
                  .ThemeColor = mycolour
                  .TintAndShade = mytint
                  .Size = mySize
               End With
               .AddIndent = True
               .IndentLevel = myindent
            End With
         End If
      ElseIf InStr(1, cell.Value, myLabel3) > 0 Then
         If cell.Offset(0, 5).Value = "" Then                        'go 5 cells to the right
            cell.Offset(0, 6).Value = 1            'activate the next cell along
            With cell.EntireRow
               .RowHeight = myHeight2                 'change the row height
               With .Font                         'change the row font and colour
                  .Italic = myitalics2
                  .Bold = mybold
                  .ThemeColor = mycolour2
                  .TintAndShade = mytint2
                  .Size = mySize2
               End With
               .AddIndent = True
               .IndentLevel = myindent2
            End With
         End If
      End If
   Next
End Sub

 

[ChloeLM]

Thanks Fluff. I sort of follow (maybe!). Are you meaning that I would use

If InStr(1, cell.Value, myLabel1) > 0 Or InStr(1, cell.Value, myLabel2) >

as a really long list, so basically list all the headings that would use formatting type 1?

This would mean that instead of having 64 blocks of code each searching for a specific heading and applying the appropriate formatting, i'd have 5 blocks of code - one for each type of formatting - with the headings being searched for all listed as 'or'?

 

[RoryA]

I'd suggest you set up a table of the header values, with columns for the corresponding format options. You can then load the entire table into an array, and simply iterate that array to find the header and then use the related formatting options. Alternatively, reverse the logic, and loop through the array of known headers, find them in column A if available, and apply the relevant formatting.

 

[eirikdaude]

While there is certainly lots of stuff you can do to make your code more elegant, I think one of the main things you can do to increase the speed of your macro is to turn off unnecessary calculations and animations while the macro is running.

I often put something like

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.Calculation = xlCalculationManual

At the beginning of my code, and then turn these settings back on at the end

    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.Calculation = xlCalculationAutomatic

If you depend on calculations in the worksheet being performed for your code to work correctly, you have to tell it to update on its own though, so you need to know what the different settings do and know when it's safe to turn them off or on.

In addition there are several other things you can do, such as avoiding using select / activate, or loading your data into an array so you don't have to work on the worksheet, as shown in the other answers here.

For more details, I'd recommend just googling for how to speed up VBA code, there are several good resources out there for how to improve the macro's speed. One example which mentions several of the methods shown in this thread is here.

Good luck with your projects!

 

[Fluff]

Are you meaning that I would use as a really long list, so basically list all the headings that would use formatting type 1?

I was, but if you have 64 different labels with the same formatting, I'd suggest using an array as Rory suggested.

 

[ChloeLM]

I'd suggest you set up a table of the header values, with columns for the corresponding format options. You can then load the entire table into an array, and simply iterate that array to find the header and then use the related formatting options. Alternatively, reverse the logic, and loop through the array of known headers, find them in column A if available, and apply the relevant formatting.

Thanks, will have a go at this