Hope one of you guys or gals, can give me a much faster way of accomplishing what my code below is very slow with.
It's task is to make sure all rows in the used range match the cell formatting in row 16.
Except leave font colors as is and leave cell background color as is, unless it is white, change it to xlnone.
Please help, as what I have written below takes about ten seconds to process only 115 rows and I'm praying it's possible to get that down to about one second.
As it stands now if I try this on 18,000 rows, I can wait 30 minutes and it's not finished yet. At that point I get frustrated from not knowing if it's even making progress, so I cntrl pause break the routine.
If it is to take a very long time to run, some sort of status bar progress indicator would be nice, so I know it's doing something.
Thanks
[vba]
Sub Trim_Cells_and_Apply_Row16_formatting_to_all_rows()
Dim i As Long
Dim j As Integer
Dim rng As Range
Dim LastRow As Long
'Application.EnableCancelKey = xlDisabled
ActiveSheet.DisplayAutomaticPageBreaks = False
LastRow = Range("G" & Rows.Count).End(xlUp).Row
Set rng = Range("A16:AD" & LastRow)
Application.ScreenUpdating = False
Application.EnableEvents = False
'borrowed this command from member aflatoon.
'- It's by far the quickest way I've ever seen to Trim before and after spaces in the range
rng = Evaluate("INDEX(TRIM(" & rng.Address(0, 0, , -1) & "),0,0)")
'Scan all the rows cell formating, and make changes if necessary, to match those found in row 16
'- Ignore background color except white, change to xlnone
For i = 17 To LastRow
For j = 1 To 30
With ActiveSheet
'if cell background color is white, change it to none
If Not .Cells(i, j).Column = 14 Then ' skip processing column 14
If .Cells(i, j).Interior.ColorIndex = 2 Then
'MsgBox "The Cell at: " & .Cells(i, j).Address & _
'" has a white background that is now being changed to xlNone backgrand"
'.Cells(i, j).Activate
.Cells(i, j).Interior.ColorIndex = xlNone
End If
.Cells(i, j).HorizontalAlignment = .Cells(16, j).HorizontalAlignment
.Cells(i, j).VerticalAlignment = .Cells(16, j).VerticalAlignment
.Cells(i, j).WrapText = .Cells(16, j).WrapText
.Cells(i, j).Orientation = .Cells(16, j).Orientation
.Cells(i, j).AddIndent = .Cells(16, j).AddIndent
.Cells(i, j).IndentLevel = .Cells(16, j).IndentLevel
.Cells(i, j).ShrinkToFit = .Cells(16, j).ShrinkToFit
.Cells(i, j).Font.Name = .Cells(16, j).Font.Name
.Cells(i, j).Font.Size = .Cells(16, j).Font.Size
'Leave the existing font color left intact
'.Cells(i, j).Font.ColorIndex = .Cells(16, j).Font.ColorIndex
.Cells(i, j).NumberFormat = .Cells(16, j).NumberFormat
.Cells(i, j).Value = .Cells(i, j).Value
'line above ensures that Excel will recognize if the cell format is changed here in the code
End If
End With
Next j
Next i
'Range("A16").Activate
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
[/vba]