2

I have made the following code which removes the need for a for loop but it still freezes up Excel. This code essentially will format 8 rows a specific way with borders, number formats, etc. I need to speed this up as I am running this alongside another macro I wrote that works in a reasonable amount of time but adding this formatting messes with something.

Sub Format()
'Borders
Range("A2:F9,G2:I3,G4:I5,G6:I7,G8:I9,J2:V3,J4:V5,J6:V7,J8:V9,W2:W9,X2:AI3,X4:AI5,X6:AI7,X8:AI9,AJ2:AJ9").Select
With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With

'Format percentages
Range("X3:AI3,X5:AI5,X7:AI7,X9:AI9").Select
Selection.NumberFormat = "0.00%"

Range("F:F,J2:W" & endRow).Select
Selection.NumberFormat = "0"

Range("J1:V1").Select
Selection.NumberFormat = "mmm-yy"

Range("X1:AI1").Select
Selection.NumberFormat = "mmm"

'Text Alignment
Range("A:A,C:C,D:D,F:AJ").Select
With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .ReadingOrder = xlContext
End With

Range("A2:AJ9").Copy
Range("A2:AJ" & endRow).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

Range("A1,C1,D1,F1:I1,W1,AJ1").EntireColumn.AutoFit
Range("B1").ColumnWidth = 32
Range("E1").ColumnWidth = 40
Range("J1:V1,X1:AI1").ColumnWidth = 7.5
End Sub

The variable endRow is determined elsewhere as this macro is called inside of another. For simplicity let's assume the endRow = 80,002 (The extra 2 accounts for the headers).

Edit 1:

For clarification there is a header row and then the data to be formatted is below. A few lines of this code modifies the header data so the following is the code without the headers being formatted for clarity on the problem.

Sub Format()
'Borders
Range("A2:F9,G2:I3,G4:I5,G6:I7,G8:I9,J2:V3,J4:V5,J6:V7,J8:V9,W2:W9,X2:AI3,X4:AI5,X6:AI7,X8:AI9,AJ2:AJ9").Select
With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With

'Format percentages
Range("X3:AI3,X5:AI5,X7:AI7,X9:AI9").Select
Selection.NumberFormat = "0.00%"

Range("F:F,J2:W" & endRow).Select
Selection.NumberFormat = "0"

'Text Alignment
Range("A:A,C:C,D:D,F:AJ").Select
With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .ReadingOrder = xlContext
End With

Range("A2:AJ9").Copy
Range("A2:AJ" & endRow).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

Range("A1,C1,D1,F1:I1,W1,AJ1").EntireColumn.AutoFit
Range("B1").ColumnWidth = 32
Range("E1").ColumnWidth = 40
Range("J1:V1,X1:AI1").ColumnWidth = 7.5
End Sub

Edit 2:

Here is an image of what the outcome should be excluding the red filled cells as I don't want to give any information about the company I work for away.

I tried what Tim Williams suggested but that just causes all cells to have all borders which I do not want.

Edit 3:

This post is getting rather long, but here is what I have come up with that I suspect could be further optimized but I am unsure of as to how that would be accomplished.

Sub Format()
Dim rng As Range
Set rng = Sht.Range("A2:F9,G2:I3,G4:I5,G6:I7,G8:I9,J2:V3,J4:V5,J6:V7,J8:V9,W2:W9,X2:AI3,X4:AI5,X6:AI7,X8:AI9,AJ2:AJ9")
'Borders
With rng.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With rng.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With rng.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With rng.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With

'Format percentages
Range("X3:AI3,X5:AI5,X7:AI7,X9:AI9").NumberFormat = "0.00%"

Range("F:F,J2:W" & endRow).NumberFormat = "0"

Range("J1:V1").NumberFormat = "mmm-yy"

Range("X1:AI1").NumberFormat = "mmm"

'Text Alignment
With Range("A:A,C:C,D:D,F:AJ")
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .ReadingOrder = xlContext
End With

Range("A2:AJ9").Copy
Range("A2:AJ" & endRow).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Range("A1,C1,D1,F1:I1,W1,AJ1").EntireColumn.AutoFit
Range("B1").ColumnWidth = 32
Range("E1").ColumnWidth = 40
Range("J1:V1,X1:AI1").ColumnWidth = 7.5
End Sub
CodeNewbie
  • 71
  • 6

3 Answers3

3

Format Thousands of Lines

Sub Format()
    
    Const EndRow As Long = 80001
    
    Application.ScreenUpdating = False
    
    With ActiveSheet ' improve!
        
        ' Borders
        With .Range("A2:F9,G2:I3,G4:I5,G6:I7,G8:I9,J2:V3,J4:V5," _
                & "J6:V7,J8:V9,W2:W9,X2:AI3,X4:AI5,X6:AI7,X8:AI9,AJ2:AJ9")
            With .Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
            With .Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
            With .Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
        End With
        
        ' Number Formats
        .Range("X3:AI3,X5:AI5,X7:AI7,X9:AI9").NumberFormat = "0.00%"
        .Range("F1:F9,J2:W9").NumberFormat = "0"
        .Range("J1:V1").NumberFormat = "mmm-yy"
        .Range("X1:AI1").NumberFormat = "mmm"
    
        ' Text Alignment
        With .Range("A1:A9,C1:C9,D1:D9,F1:AJ9")
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .ReadingOrder = xlContext
        End With
        
        ' Copy Down Formats
        .Range("A2:AJ9").Copy
        .Range("A2:AJ" & EndRow).PasteSpecial Paste:=xlPasteFormats
        
        ' Column Widths
        .Range("A1,C1,D1,F1:I1,W1,AJ1").EntireColumn.AutoFit
        .Range("B1").ColumnWidth = 32
        .Range("E1").ColumnWidth = 40
        .Range("J1:V1,X1:AI1").ColumnWidth = 7.5
    
    End With
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
End Sub

Argumented

  • Rewrite the previous sub by adding the worksheet argument.
Sub FormatSheet(ByVal ws As Worksheet)

    Const EndRow As Long = 80001

    Application.ScreenUpdating = False

    With ws
    

    End With

    Application.CutCopyMode = False
    Application.ScreenUpdating = True

End Sub
  • Finally, call the sub from another sub.
Sub Test()

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    FormatSheet ws

End Sub

  • Similarly, you could add the EndRow argument...

    Sub FormatSheet2(ByVal ws As Worksheet, ByVal EndRow As Long)

End Sub

    and call it with e.g.:

    FormatSheet2 ws, 80001
VBasic2008
  • 44,888
  • 5
  • 17
  • 28
  • In the first portion of this code regarding the borders, is it better to do as you have done using "with" or should I use "set" on a range variable and call it that way as you can see in my most recent edit? – CodeNewbie Apr 19 '22 at 17:50
  • Also I set the sheet it is using in a parent sub that calls this sub so active sheet isn't necessary – CodeNewbie Apr 19 '22 at 17:51
  • Regarding the borders, it's all the same: this has no variable, yours has a variable. Regarding the set worksheet, using a worksheet argument would be preferred: `Sub Format(ByVal ws As Worksheet)` and replace `ActiveSheet` with `ws`. Will be adding it to the answer. – VBasic2008 Apr 19 '22 at 17:55
  • I currently have all the subs I am calling set as private subs so that the users of my macro will not see them when adding to the command ribbon. I am using application.run to call the macros since they are private. Is there a specific way I need to "call" the macros in order to add arguments? – CodeNewbie Apr 19 '22 at 19:52
0

create 2 new class modules and call them by whatever name you want, just for the sake of explanation let's call them SettingClass1 and SettingClass2.

On SettingClass1 write the following code:

Option Explicit

Private calculation As XlCalculation
Private displayStatus As Boolean
Private enableEvents As Boolean
Private screenUpdating As Boolean

Public Sub Backup()

calculation = Application.calculation
displayStatus = Application.DisplayStatusBar
enableEvents = Application.enableEvents
screenUpdating = Application.screenUpdating

End Sub

Public Sub Restore()

Application.calculation = calculation
Application.DisplayStatusBar = displayStatus
Application.enableEvents = enableEvents
Application.screenUpdating = screenUpdating
 
End Sub

Public Sub TurnOff()

Call Backup

Application.calculation = xlCalculationManual
Application.DisplayStatusBar = False
Application.enableEvents = False
Application.screenUpdating = False

End Sub

Public Sub TurnOn()

Application.calculation = xlCalculationAutomatic
Application.DisplayStatusBar = True
Application.enableEvents = True
Application.screenUpdating = True

End Sub

After that on SettingClass2 write the following code:

Option Explicit

Private Interactive As Boolean
Private DisplayAlerts As Boolean
Private AskUpdateLinks As Boolean

Public Sub Backup()

Interactive = Application.Interactive
DisplayAlerts = Application.DisplayAlerts
AskUpdateLinks = Application.AskToUpdateLinks

End Sub

Public Sub Restore()

Application.Interactive = Interactive
Application.DisplayAlerts = DisplayAlerts
Application.AskToUpdateLinks = AskUpdateLinks
 
End Sub

Public Sub TurnOff()

Call Backup

Application.Interactive = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False

End Sub

Public Sub TurnOn()

Application.Interactive = True
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True

End Sub

Afterwards edit your code by adding:

Sub Format()

Dim settings As New SettingClass1
Dim settingsAlerts As New SettingClass2

settings.TurnOff
settingsAlerts.TurnOff

'Borders

Then at the end of your code add:

Range("J1:V1,X1:AI1").ColumnWidth = 7.5

settings.TurnOn
settingsAlerts.TurnOn

End Sub

I have noticed that in your code sht isn't declared or set anywhere, and also endRow.

So I wrote the code declaring sht as a worksheet and endRow as a Long, however you need to set sht and assign a value to endRow.

You can also optimize further your code by changing it like this:

Sub Format()

Dim settings As New SettingClass1
Dim settingsAlerts As New SettingClass2

settings.TurnOff
settingsAlerts.TurnOff

Dim rng As Range
Dim area As Variant
Dim sht As Worksheet
Dim endRow as Long

'Code here to set the worksheet sht
'Set sht = '''whatever you need to write here to set the worksheet
'Code here to assign a value to endRow
'endRow = '''whatever you need to write here to assign the appropiate value to endRow

Set rng = sht.Range("A2:F9,G2:I3,G4:I5,G6:I7,G8:I9,J2:V3,J4:V5,J6:V7,J8:V9,W2:W9,X2:AI3,X4:AI5,X6:AI7,X8:AI9,AJ2:AJ9")
'Borders

For Each area In rng.areas
    
    With area
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlMedium
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlMedium
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlMedium
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
        End With
    End With

Next area

'Format percentages
With sht
    
    Set rng = .Range("X3:AI3,X5:AI5,X7:AI7,X9:AI9")
    
    For Each area In rng.areas
        
        With area
            
            .NumberFormat = "0.00%"
            
        End With
        
    Next area
    
    Set rng = .Range("F:F,J2:W" & endRow)
    
    For Each area In rng.areas
        
        With area
            
            .NumberFormat = "0"
            
        End With
        
    Next area
    
    
    .Range("J1:V1").NumberFormat = "mmm-yy"
    
    .Range("X1:AI1").NumberFormat = "mmm"
    
    'Text Alignment
    
    Set rng = .Range("A:A,C:C,D:D,F:AJ")
    
    For Each area In rng.areas
        
        With area
            
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .ReadingOrder = xlContext
            
        End With
        
    Next area
    
    .Range("A2:AJ9").Copy
    .Range("A2:AJ" & endRow).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
    Set rng = .Range("A1,C1,D1,F1:I1,W1,AJ1")
    
    For Each area In rng.areas
        
        With area
            
            .EntireColumn.AutoFit
            
        End With
        
    Next area
    
    .Range("B1").ColumnWidth = 32
    .Range("E1").ColumnWidth = 40
    
    Set rng = .Range("J1:V1,X1:AI1")
    
    For Each area In rng.areas
        
        With area
            
            .ColumnWidth = 7.5
            
        End With
        
    Next area
    
End With

settings.TurnOn
settingsAlerts.TurnOn

End Sub

Let me know how this works for you.

UPDATE:

You can call functions and subs by using the following functions, choose carefully if you need to run a sub, a function that returns a variable which can be stored in a variant, or a variable that needs to be stored on an object.

The optional arguments can only be variants, not objects, so you can't pass a worksheet as argument.

wbk should be set to be the workbook where the macro you want to run is located, MacroName should be the name of the function/sub that you want to run.

It will not work if the workbook is located on OneDrive, if such is the case I can modify the provided functions to work also if the workbook is located on the OneDrive.

Public Function RunFunctionObject(wbk As Workbook, MacroName As String, Optional Arg1 As Variant = "", _
    Optional Arg2 As Variant = "", Optional Arg3 As Variant = "", Optional Arg4 As Variant = "", Optional Arg5 As Variant = "", _
    Optional Arg6 As Variant = "", Optional Arg7 As Variant = "", Optional Arg8 As Variant = "", Optional Arg9 As Variant = "", _
    Optional Arg10 As Variant = "", Optional Arg11 As Variant = "", Optional Arg12 As Variant = "", Optional Arg13 As Variant = "", _
    Optional Arg14 As Variant = "", Optional Arg15 As Variant = "", Optional Arg16 As Variant = "", Optional Arg17 As Variant = "", _
    Optional Arg18 As Variant = "", Optional Arg19 As Variant = "", Optional Arg20 As Variant = "", Optional Arg21 As Variant = "", _
    Optional Arg22 As Variant = "", Optional Arg23 As Variant = "", Optional Arg24 As Variant = "", Optional Arg25 As Variant = "", _
    Optional Arg26 As Variant = "", Optional Arg27 As Variant = "", Optional Arg28 As Variant = "", Optional Arg29 As Variant = "", _
    Optional Arg30 As Variant = "") As Object

'RunFunctionObject executes the function named MacroName which is found on the workbook Wbk _
' and returns the functions RETURN object

Dim MacroString As String

MacroString = "'" & wbk.Path & Application.PathSeparator & wbk.name & "'!" & MacroName

If Arg1 = "" Then
    Set RunFunctionObject = Application.Run(MacroString)
ElseIf Arg2 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1)
ElseIf Arg3 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2)
ElseIf Arg4 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3)
ElseIf Arg5 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4)
ElseIf Arg6 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg5)
ElseIf Arg7 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6)
ElseIf Arg8 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7)
ElseIf Arg9 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8)
ElseIf Arg10 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9)
ElseIf Arg11 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10)
ElseIf Arg12 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11)
ElseIf Arg13 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12)
ElseIf Arg14 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13)
ElseIf Arg15 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14)
ElseIf Arg16 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15)
ElseIf Arg17 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16)
ElseIf Arg18 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17)
ElseIf Arg19 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18)
ElseIf Arg20 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19)
ElseIf Arg21 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20)
ElseIf Arg22 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21)
ElseIf Arg23 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22)
ElseIf Arg24 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23)
ElseIf Arg25 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24)
ElseIf Arg26 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25)
ElseIf Arg27 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26)
ElseIf Arg28 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27)
ElseIf Arg29 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28)
ElseIf Arg30 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28, Arg29)
ElseIf Arg30 <> "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28, Arg29, Arg30)
End If

End Function

Public Function RunFunctionVariant(wbk As Workbook, MacroName As String, Optional Arg1 As Variant = "", _
    Optional Arg2 As Variant = "", Optional Arg3 As Variant = "", Optional Arg4 As Variant = "", Optional Arg5 As Variant = "", _
    Optional Arg6 As Variant = "", Optional Arg7 As Variant = "", Optional Arg8 As Variant = "", Optional Arg9 As Variant = "", _
    Optional Arg10 As Variant = "", Optional Arg11 As Variant = "", Optional Arg12 As Variant = "", Optional Arg13 As Variant = "", _
    Optional Arg14 As Variant = "", Optional Arg15 As Variant = "", Optional Arg16 As Variant = "", Optional Arg17 As Variant = "", _
    Optional Arg18 As Variant = "", Optional Arg19 As Variant = "", Optional Arg20 As Variant = "", Optional Arg21 As Variant = "", _
    Optional Arg22 As Variant = "", Optional Arg23 As Variant = "", Optional Arg24 As Variant = "", Optional Arg25 As Variant = "", _
    Optional Arg26 As Variant = "", Optional Arg27 As Variant = "", Optional Arg28 As Variant = "", Optional Arg29 As Variant = "", _
    Optional Arg30 As Variant = "") As Variant

'RunFunctionVariant executes the function named MacroName which is found on the workbook Wbk _
' and returns the functions RETURN variable

Dim MacroString As String

MacroString = "'" & wbk.Path & Application.PathSeparator & wbk.name & "'!" & MacroName

If Arg1 = "" Then
    RunFunctionVariant = Application.Run(MacroString)
ElseIf Arg2 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1)
ElseIf Arg3 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2)
ElseIf Arg4 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3)
ElseIf Arg5 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4)
ElseIf Arg6 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg5)
ElseIf Arg7 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6)
ElseIf Arg8 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7)
ElseIf Arg9 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8)
ElseIf Arg10 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9)
ElseIf Arg11 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10)
ElseIf Arg12 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11)
ElseIf Arg13 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12)
ElseIf Arg14 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13)
ElseIf Arg15 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14)
ElseIf Arg16 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15)
ElseIf Arg17 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16)
ElseIf Arg18 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17)
ElseIf Arg19 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18)
ElseIf Arg20 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19)
ElseIf Arg21 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20)
ElseIf Arg22 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21)
ElseIf Arg23 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22)
ElseIf Arg24 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23)
ElseIf Arg25 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24)
ElseIf Arg26 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25)
ElseIf Arg27 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26)
ElseIf Arg28 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27)
ElseIf Arg29 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28)
ElseIf Arg30 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28, Arg29)
ElseIf Arg30 <> "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28, Arg29, Arg30)
End If

End Function

Public Sub RunSub(wbk As Workbook, MacroName As String, Optional Arg1 As Variant = "", _
    Optional Arg2 As Variant = "", Optional Arg3 As Variant = "", Optional Arg4 As Variant = "", Optional Arg5 As Variant = "", _
    Optional Arg6 As Variant = "", Optional Arg7 As Variant = "", Optional Arg8 As Variant = "", Optional Arg9 As Variant = "", _
    Optional Arg10 As Variant = "", Optional Arg11 As Variant = "", Optional Arg12 As Variant = "", Optional Arg13 As Variant = "", _
    Optional Arg14 As Variant = "", Optional Arg15 As Variant = "", Optional Arg16 As Variant = "", Optional Arg17 As Variant = "", _
    Optional Arg18 As Variant = "", Optional Arg19 As Variant = "", Optional Arg20 As Variant = "", Optional Arg21 As Variant = "", _
    Optional Arg22 As Variant = "", Optional Arg23 As Variant = "", Optional Arg24 As Variant = "", Optional Arg25 As Variant = "", _
    Optional Arg26 As Variant = "", Optional Arg27 As Variant = "", Optional Arg28 As Variant = "", Optional Arg29 As Variant = "", _
    Optional Arg30 As Variant = "")

'RunSub executes the sub named MacroName which is found on the workbook Wbk

Dim MacroString As String

MacroString = "'" & wbk.Path & Application.PathSeparator & wbk.name & "'!" & MacroName

If Arg1 = "" Then
    Application.Run MacroString
ElseIf Arg2 = "" Then
    Application.Run MacroString, Arg1
ElseIf Arg3 = "" Then
    Application.Run MacroString, Arg1, Arg2
ElseIf Arg4 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3
ElseIf Arg5 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4
ElseIf Arg6 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg5
ElseIf Arg7 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6
ElseIf Arg8 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7
ElseIf Arg9 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8
ElseIf Arg10 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9
ElseIf Arg11 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10
ElseIf Arg12 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11
ElseIf Arg13 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12
ElseIf Arg14 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13
ElseIf Arg15 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14
ElseIf Arg16 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15
ElseIf Arg17 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16
ElseIf Arg18 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17
ElseIf Arg19 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18
ElseIf Arg20 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19
ElseIf Arg21 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20
ElseIf Arg22 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21
ElseIf Arg23 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22
ElseIf Arg24 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23
ElseIf Arg25 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24
ElseIf Arg26 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25
ElseIf Arg27 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26
ElseIf Arg28 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27
ElseIf Arg29 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28
ElseIf Arg30 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28, Arg29
ElseIf Arg30 <> "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28, Arg29, Arg30
End If

End Sub

IMPORTANT!!:

If you're turning sreenupdating to false and then back to true in the overarching code, THEN you should declare and define the settings and settingsAlerts on the overarching code instead of doing it inside the Format() sub like I did here.

The turning off of the settings and settingsAlerts will extremely speed up your code.

Furthermore, by treating each different area separately the way I did using the For each loops, the speed is greatly improved on your code.

Using the With statements will also help speed up the code because the compiler will need to interpret less code.

I hope all of this was informative and helpfull to you.

Let me know how this will work out.

David
  • 38
  • 6
  • Thanks for this comprehensive breakdown. As for "Sht" and "endRow" they are actually declared in the parent macro that calls this one because I am using this macro as more of a code block to simplify my code. I found a solution that made my code speed up quite a bit and will post my own answer for any further onlookers, but for now it satisfices what I need it to do in a reasonable time. – CodeNewbie Apr 21 '22 at 21:27
0

I found a solution that has been inspired by many of the comments and other answers in this thread. I hope it will help any further viewers of this thread.

Private Sub Format()
Dim rng As Range
Set rng = Sht.Range("A2:F9,G2:I3,G4:I5,G6:I7,G8:I9,J2:V3,J4:V5,J6:V7,J8:V9,W2:W9,X2:AI3,X4:AI5,X6:AI7,X8:AI9,AJ2:AJ9")
With Sht
'Borders
With rng.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With rng.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With rng.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With rng.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With

'Format percentages
.Range("X3:AI3,X5:AI5,X7:AI7,X9:AI9").NumberFormat = "0.00%"

.Range("F:F,J2:W" & endRow).NumberFormat = "0"

.Range("J1:V1").NumberFormat = "mmm-yy"

.Range("X1:AI1").NumberFormat = "mmm"

'Text Alignment
With .Range("A:A,C:C,D:D,F:AJ")
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .ReadingOrder = xlContext
End With

.Range("A2:AJ9").Copy
.Range("A2:AJ" & endRow).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

.Range("A1,C1,D1,F1:I1,W1,AJ1").EntireColumn.AutoFit
.Range("B1").ColumnWidth = 32
.Range("E1").ColumnWidth = 40
.Range("J1:V1,X1:AI1").ColumnWidth = 7.5
End With
End Sub

Most of this is very specific to my situation though so this may not be the most helpful to others but I digress.

CodeNewbie
  • 71
  • 6