VBA code too slow. Ideas for improvement?

[excelstarter1]

Hello,

a couple of weeks ago I wrote a macro to format the title of a table in Excel. A task which I repeat every 20 minutes or so. So far the marco does exactly what I want. However, for some odd reason the execution of the code gets slower and slower by the minute. Maybe the code is flawed in general, unfortunately I am not yet a VBA pro. In the morning the exection of e.g. 10 cells took less than a second. In the evening the execution took 3-4 seconds and you can watch the code working through each cell on the screen.

I created a Ribbon for Excel, so that I have all my macros stored in a toolbar. But I assume that the macro does not interfer with the other macros. There is no link or the like. Each macro/sub runs seperately without interactions.

It would be great if you could take a look at the code and suggest an improvement. Thank you very much in advance!!

Regards

Option Explicit

Sub format_table()
'I run the macro within the Ribbon so the original Sub would be: Sub format_table(control As IRibbonControl)
    
On Error GoTo ErrorHandler
    
    Application.ScreenUpdating = False
    
    Dim cell As Range
    Dim selec As Range
    Dim numbr As Integer
    
    Set selec = Selection
    
    numbr = selec.Columns.Count
    
        With selec
            .ClearFormats
            .Interior.Pattern = xlSolid
            .Interior.PatternColorIndex = xlAutomatic
            .Interior.Color = rgb(100, 100, 100)
            .Font.Bold = True
            .Font.Italic = False
            .Font.Name = "Arial"
            .Font.Size = 12
            .Font.Color = rgb(200, 200, 200)
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .RowHeight = 12.75
        End With
    
    If Not IsNumeric(selec.Columns(1)) Then
        selec.Columns(1).HorizontalAlignment = xlRight
        'if cell is text in first column of selected area than move right
    Else
    End If
    
    numbr = selec.Columns.Count
    
    If numbr = 1 Then
        selec.HorizontalAlignment = xlRight
        'special case, if only one column selected than move content of selected area right
    End If
           
    Application.ScreenUpdating = True
    
Exit Sub
    
ErrorHandler:

    Debug.Print "Error: " & Err.number & " " & Err.Description
    Err.Clear
    Resume Next
    
End Sub

 

[excelstarter1]

I tried it with the following code. But I am sure there is room for improvement (get rid of loop / for each)...

            If .Count = 1 Then
            If Not Selection.HasFormula And Len(Selection.Formula) <> 0 And Not IsNumeric(Selection.Formula) Then
                Selection.HorizontalAlignment = xlLeft
            End If
            Else
                For Each c In .Cells.SpecialCells(xlCellTypeConstants, xlTextValues)
                    c.HorizontalAlignment = xlLeft
                Next c
            End If

Sorry to bother you again...
I just tested the code. When I select a single cell with a value/number, ALL SpecialCells with Text move to the left. How would I get rid of the issue?

 

[excelstarter1]

I added another piece of code (last for each routine), so that each numeric value (also as output from a formula) is considered. Text = left (horizontal alignment), numeric values = right.

Do you have a recommendation on how to improve the code? I read that all those for each routines slow down the execution...

Thanks! Regards

Option Explicit

Sub format_table2()

    On Error GoTo ErrorHandler
    
    Dim c as Range 'cell

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    With Selection
        .HorizontalAlignment = xlRight
        If .Count = 1 Then
            If Not .HasFormula And Len(.Formula) <> 0 And Not IsNumeric(.Formula) Then
                .HorizontalAlignment = xlLeft
            End If
            Else
                For Each c In .Cells.SpecialCells(xlCellTypeConstants, xlTextValues)
                    c.HorizontalAlignment = xlLeft
                Next c
            End If
            
            For Each c In .Cells
            If IsNumeric(c.Value) Then
                c.HorizontalAlignment = xlRight
            Else
                c.HorizontalAlignment = xlLeft
            End If
            Next c

End With

ErrorHandler:
    Debug.Print "Error: " & err.Number & " " & err.Description
    err.Clear
    Resume Next

End Sub