Djblois
03-26-2007, 08:54 AM
A lot of individuals in my company are not that good with Excel, so to try to make things look good they add blank columns at the beginning to center things and blank rows. I am creating a macro that will fix up formating for them and for myself if they send me a spreadsheet like that. This is what I have so far:
Sub FormatTable()
Dim finalRowLast As Long
Dim finalHeader As Long
Dim cellObject As Range
Error00_00_01code
If Range("A1") = "" Then
End
End If
SpeedyPageSetup
TurnOffFeatures
With ActiveSheet
finalRow = .Cells(.Rows.Count, "A").End(xlUp).Row
finalColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
finalRowLast = .Cells(Rows.Count, finalColumn).End(xlUp).Row
If finalRowLast > finalRow Then finalRow = finalRowLast
End With
Cells(2, 1).Resize(finalRow, finalColumn).Interior.ColorIndex = xlNone
For i = 3 To finalRow Step 2
Cells(i, 1).Resize(1, finalColumn).Interior.ColorIndex = 34
Next
Range("A1").Resize(1, finalColumn).Select
For Each cellObject In Selection
cellObject.Formula = WorksheetFunction.Proper(cellObject.Formula)
Next
ResizeAndFit
ColumnHeadingsA
End Sub
A few changes I want to make that I can't figure out how to do is:
I want it to find the first cell in the table (Eg: B1 or D4) then I want to delete all the rows and columns until it is A1
Next, I want it to delete any blank rows in between.This would only be used on Tables created by Users, no other types of spreadsheets
Sub FormatTable()
Dim finalRowLast As Long
Dim finalHeader As Long
Dim cellObject As Range
Error00_00_01code
If Range("A1") = "" Then
End
End If
SpeedyPageSetup
TurnOffFeatures
With ActiveSheet
finalRow = .Cells(.Rows.Count, "A").End(xlUp).Row
finalColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
finalRowLast = .Cells(Rows.Count, finalColumn).End(xlUp).Row
If finalRowLast > finalRow Then finalRow = finalRowLast
End With
Cells(2, 1).Resize(finalRow, finalColumn).Interior.ColorIndex = xlNone
For i = 3 To finalRow Step 2
Cells(i, 1).Resize(1, finalColumn).Interior.ColorIndex = 34
Next
Range("A1").Resize(1, finalColumn).Select
For Each cellObject In Selection
cellObject.Formula = WorksheetFunction.Proper(cellObject.Formula)
Next
ResizeAndFit
ColumnHeadingsA
End Sub
A few changes I want to make that I can't figure out how to do is:
I want it to find the first cell in the table (Eg: B1 or D4) then I want to delete all the rows and columns until it is A1
Next, I want it to delete any blank rows in between.This would only be used on Tables created by Users, no other types of spreadsheets