Is it possible to speed-up background / text / border formatting?

Question

PLEASE SEE AHMED AU\'S ANSWER AT THE END - HIS SOLUTION IS FANTASTIC! AFTER MY OLD CODE, I HAVE MY LATEST VERSION. THE DIFFERENCE IN SPEED IS STAGGERING!

<

Answer 1

tried with the code (with approach to Calculate and then write each format category in one shot) and found working in seconds

Sub Dark_mode()
tm = Timer
Dim Ws As Worksheet
Dim iR As Integer, iG As Integer, iB As Integer, fR As Integer, fG As Integer, fB As Integer
Dim Rw As Long, Col As Long
Dim Rng As Range

Dim IcRng1 As Range, IcRng2 As Range, IcRng3 As Range, IcRng4 As Range, IcRng5 As Range, IcRng6 As Range, IcRng7 As Range, IcRng8 As Range
Dim IClr1 As Long, IClr2 As Long, IClr3 As Long, IClr4 As Long, IClr5 As Long, IClr6 As Long, IClr7 As Long, IClr8 As Long
Dim fcRng1 As Range, fcRng2 As Range, fcRng3 As Range, fcRng4 As Range, fcRng5 As Range
Dim fClr1 As Long, fClr2 As Long, fClr3 As Long, fClr4 As Long, fClr5 As Long
Dim BrdRngL As Range, BrdRngR As Range, BrdRngT As Range, BrdRngB As Range
Dim BrdClr As Long

Dim OldStatusBar As Boolean, current_run, line_start, line_end, column_start, column_end As Integer
Dim IntClr As Long, FntClr As Long, BrdL As Long, BrdR As Long, BrdT As Long, BrdB As Long
Dim LnCnt As Long, ColCnt As Long

' SET HERE LINES AND COLUMNS TO TRANSFORM
line_start = 211
line_end = 223

column_start = 1
column_end = 160

LnCnt = line_end - line_start + 1
ColCnt = column_end - column_start + 1

BrdClr = RGB(255, 217, 102)
IClr1 = RGB(51, 51, 51) 'white TO background I
IClr2 = RGB(41, 41, 41) 'light gray TO background II
IClr3 = RGB(0, 0, 0) 'dark gray TO backgroun III
IClr4 = RGB(0, 102, 0) 'black TO green (May be combined with iclr5 & 6)
IClr5 = RGB(0, 102, 0) 'gray TO green (May be combined with iclr4)
IClr6 = RGB(0, 102, 0) 'gray TO green (May be combined with iclr4)
IClr7 = RGB(0, 51, 153) 'yellow TO blue
IClr8 = RGB(120, 25, 25) 'bright yellow TO red

fClr1 = RGB(255, 255, 255) 'black TO white
fClr2 = RGB(0, 255, 0) 'blue TO green
fClr3 = RGB(0, 176, 240) 'green TO blue
fClr4 = RGB(255, 204, 0) 'magenta TO orange
fClr5 = RGB(0, 204, 152) 'light blue TO pale green


Set Ws = ThisWorkbook.ActiveSheet
Set Rng = Ws.Range(Cells(line_start, column_start), Cells(line_end, column_end))

For Rw = 1 To LnCnt
    For Col = 1 To ColCnt

    IntClr = Rng(Rw, Col).Interior.Color
    FntClr = Rng(Rw, Col).Cells.Font.Color
    BrdL = Rng(Rw, Col).Borders(xlEdgeLeft).LineStyle
    BrdR = Rng(Rw, Col).Borders(xlEdgeRight).LineStyle
    BrdT = Rng(Rw, Col).Borders(xlEdgeTop).LineStyle
    BrdB = Rng(Rw, Col).Borders(xlEdgeBottom).LineStyle

          iR = IntClr Mod 256
          iG = (IntClr Mod 256 ^ 2) \ 256
          iB = IntClr \ (256 ^ 2)

          fR = FntClr Mod 256
          fG = (FntClr Mod 256 ^ 2) \ 256
          fB = FntClr \ (256 ^ 2)


        'CORE BACKGROUND
        If iR = 255 And iG = 255 And iB = 255 Then Set IcRng1 = SimpleUnion(IcRng1, Rng(Rw, Col))
        If iR = 227 And iG = 227 And iB = 227 Then Set IcRng2 = SimpleUnion(IcRng2, Rng(Rw, Col))
        If iR = 192 And iG = 192 And iB = 192 Then Set IcRng3 = SimpleUnion(IcRng3, Rng(Rw, Col))
        'CORE TOPIC
        If iR = 0 And iG = 0 And iB = 0 Then Set IcRng4 = SimpleUnion(IcRng4, Rng(Rw, Col))
        ' Ad hoc grays converted to green
        If iR = 128 And iG = 128 And iB = 128 Then Set IcRng5 = SimpleUnion(IcRng5, Rng(Rw, Col))
        If iR = 217 And iG = 217 And iB = 217 Then Set IcRng6 = SimpleUnion(IcRng6, Rng(Rw, Col))
        'CORE INPUT
        If iR = 255 And iG = 255 And iB = 153 Then Set IcRng7 = SimpleUnion(IcRng7, Rng(Rw, Col))
        If iR = 255 And iG = 255 And iB = 0 Then Set IcRng8 = SimpleUnion(IcRng8, Rng(Rw, Col))


        'CORE TEXT
        If fR = 0 And fG = 0 And fB = 0 Then Set fcRng1 = SimpleUnion(fcRng1, Rng(Rw, Col))
        If fR = 0 And fG = 0 And fB = 255 Then Set fcRng2 = SimpleUnion(fcRng2, Rng(Rw, Col))
        If fR = 0 And fG = 128 And fB = 0 Then Set fcRng3 = SimpleUnion(fcRng3, Rng(Rw, Col))
        If fR = 128 And fG = 0 And fB = 128 Then Set fcRng4 = SimpleUnion(fcRng4, Rng(Rw, Col))
        If fR = 0 And fG = 128 And fB = 128 Then Set fcRng5 = SimpleUnion(fcRng5, Rng(Rw, Col))


        'CORE BORDERS (bottom/top/right/left colors)
        If BrdL <> -4142 Then Set BrdRngL = SimpleUnion(BrdRngL, Rng(Rw, Col))
        If BrdR <> -4142 Then Set BrdRngR = SimpleUnion(BrdRngR, Rng(Rw, Col))
        If BrdT <> -4142 Then Set BrdRngT = SimpleUnion(BrdRngT, Rng(Rw, Col))
        If BrdB <> -4142 Then Set BrdRngB = SimpleUnion(BrdRngB, Rng(Rw, Col))
   Next Col
Next Rw

Debug.Print "Calc Over " & Timer - tm
'Prevents screen refreshing
    Application.ScreenUpdating = False

If Not IcRng1 Is Nothing Then IcRng1.Interior.Color = IClr1
If Not IcRng2 Is Nothing Then IcRng2.Interior.Color = IClr2
If Not IcRng3 Is Nothing Then IcRng3.Interior.Color = IClr3
If Not IcRng4 Is Nothing Then IcRng4.Interior.Color = IClr4
If Not IcRng5 Is Nothing Then IcRng5.Interior.Color = IClr5
If Not IcRng6 Is Nothing Then IcRng6.Interior.Color = IClr6
If Not IcRng7 Is Nothing Then IcRng7.Interior.Color = IClr7
If Not IcRng8 Is Nothing Then IcRng8.Interior.Color = IClr8

If Not fcRng1 Is Nothing Then fcRng1.Font.Color = fClr1
If Not fcRng2 Is Nothing Then fcRng2.Font.Color = fClr2
If Not fcRng3 Is Nothing Then fcRng3.Font.Color = fClr3
If Not fcRng4 Is Nothing Then fcRng4.Font.Color = fClr4
If Not fcRng5 Is Nothing Then fcRng5.Font.Color = fClr5

'may be all 4 type of BrdRng combined to one
If Not BrdRngL Is Nothing Then BrdRngL.Borders(xlEdgeLeft).Color = BrdClr
If Not BrdRngR Is Nothing Then BrdRngR.Borders(xlEdgeRight).Color = BrdClr
If Not BrdRngT Is Nothing Then BrdRngT.Borders(xlEdgeTop).Color = BrdClr
If Not BrdRngB Is Nothing Then BrdRngB.Borders(xlEdgeBottom).Color = BrdClr

Debug.Print "Final " & Timer - tm


'Enables screen refreshing
    Application.ScreenUpdating = True

End Sub
Function SimpleUnion(Xrng As Range, Yrng As Range) As Range
If Xrng Is Nothing Then
Set SimpleUnion = Yrng
Else
Set SimpleUnion = Union(Xrng, Yrng)
End If
End Function

may be modified to your requirements. if found to achieve required speed with actual files involved may be looped for formatting multiple files and multiple ranges from a simple master file (containing the macro) with a list of File path,names, sheet and ranges.

Any further problems, clarification, feedback would be appreciated.