Solved: create User Friendly Spreadsheet

[Djblois]

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:

[VBA]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[/VBA]

A few changes I want to make that I can't figure out how to do is:

1. 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
2. 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

[Zack Barresse]

Delete blank rows? Maybe something like this ...


[vba]Sub DeleteBlankRows()
Dim ws As Worksheet, LastRow As Long, i As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
LastRow = ws.Cells.Find(what:="*", after:=ws.Range("A1"), searchorder:=xlByRows, searchdirection:=xlPrevious).Row
For i = LastRow To 1 Step -1
If WorksheetFunction.CountA(ws.Rows(i)) = 0 Then
ws.Rows(i).Delete
End If
Next i
End Sub[/vba]

[Djblois]

Thank you, I am about to test that but how do I get it in the A column if it isn't in the A column already?

[Zack Barresse]

What do you mean "in the A column"?

[lucas]

questions, questions, questions.......

[Djblois]

if the first cell is B1, I would like to delete the A column, if it is C1, I would like to delete the A column and the B column

[Bob Phillips]

[vba]

Dim rng As Range

Set rng = Range("A1").SpecialCells(xlCellTypeConstants, 23)

If rng.Column > 1 Then
Columns(1).Resize(, rng.Column - 1).Delete
End If

If rng.Row > 1 Then
Rows(1).Resize(rng.Row - 1).Delete
End If

[/vba]

[Djblois]

THis is what I have now and it works great except sometimes it is deleting the first column with data:

[VBA]
Dim finalRowLast As Long
Dim finalHeader As Long
Dim cellObject As Range
Dim rng As Range
Set firstUserForm = TableFormating

Error00_00_01code

SpeedyPageSetup
TurnOffFeatures

Set rng = Range("A1").SpecialCells(xlCellTypeConstants, 23)

If rng.Column > 1 Then
Columns(1).Resize(, rng.Column - 1).Delete
End If
If rng.Row > 1 Then
Rows(1).Resize(rng.Row - 1).Delete
End If

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

If TableFormating.YesBand Then
For i = 3 To finalRow Step 2
Cells(i, 1).Resize(1, finalColumn).Interior.ColorIndex = 34
Next
End If

Range("A1").Resize(1, finalColumn).Select
For Each cellObject In Selection
cellObject.Formula = WorksheetFunction.Proper(cellObject.Formula)
Next

ResizeAndFit

If TableFormating.HeaderYes Then
ColumnHeadingsA
End If
If TableFormating.YesTotals Then
TotalRowCommon
End If

End Sub[/VBA]

[Bob Phillips]

Daniel,

Can you post an example workbook where it does that, as it worked in my tests.

[Djblois]

ok

[lucas]

Bob's code deletes rows 1 & 2
and
deletes Columns A & B
tested.

[lucas]

correction....it was getting one of the columns...try this variation of Bob's code:
[VBA]Dim rng As Range

Set rng = Range("A1").SpecialCells(xlCellTypeConstants, 23)

If rng.Column > 1 Then
Columns(1).Resize(, rng.Column - 2).Delete
End If

If rng.Row > 1 Then
Rows(1).Resize(rng.Row - 1).Delete
End If[/VBA]

[Bob Phillips]

That might fail in other circumstances, this is more generic [vba] Dim rng As Range
Dim oArea As Range
Dim nFirstCol As Double
Dim nFirstRow As Double
Set rng = Range("A1").SpecialCells(xlCellTypeConstants, 23)
nFirstCol = 10 ^ 10
For Each oArea In rng.Areas
If oArea.Column < nFirstCol Then nFirstCol = oArea.Column
End If
Next oArea
If nFirstCol > 1 Then Columns(1).Resize(, nFirstCol - 1).Delete
End If
nFirstRow = 10 ^ 10
For Each oArea In rng.Areas
If oArea.Column < nFirstRow Then
nFirstRow = oArea.Row
End If
Next oArea
If rng.Row > 1 Then
Rows(1).Resize(nFirstRow - 1).Delete
End If
[/vba]
Fixed: Lucas

[Djblois]

That works now