Trying to AutoFormat an Excel Spreadsheet…
Sub OLVIMS_REPORT()
'======================================================
' CLOSED 868 REPORT AUTO FORMAT SCRIPT/MACRO
'======================================================
Columns("A:B").Select
Selection.Delete Shift:=xlToLeft
Range("H1").Select
Cells.Replace What:="END OF REPORT", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A2").Select
Columns("H:H").EntireColumn.AutoFit
Columns("I:I").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Range("A2:I2").Select
Selection.Cut Destination:=Range("H1:P1")
Range("A4:I4").Select
Selection.Cut Destination:=Range("H3:P3")
' the rest was cut out
'
' Delete Blank Rows Macro
'
On Error Resume Next
Columns("I:I").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'
' auto_width Macro
'
'
Columns("A:Z").EntireColumn.AutoFit
'
' COLOR Macro
'
'
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual 'pre XL97 xlManual
Dim Rng As Range, ix As Long
Set Rng = Intersect(Range("P:P"), ActiveSheet.UsedRange)
For ix = Rng.Count To 1 Step -1
If Trim(Replace(Rng.Item(ix).Text, Chr(160), Chr(32))) = "" Then
Rng.Item(ix).ClearContents
End If
Next
done:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Columns("H:H").SpecialCells(xlCellTypeBlanks).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.COLOR = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Columns("P:P").Select
Columns("P:P").SpecialCells(xlCellTypeBlanks).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.COLOR = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub
Here is the full code, in txt format.