Macro to format a sheet with variable # of rows

Alex881

New Member
Joined
May 6, 2019
Messages
39
I'm new to Macros, but I'm trying to write one that does the same formatting (e.g., bolds columns, adds a total, adds a column, etc) regardless of the number of rows. The data I'm working with will have a different number of rows each time, but the columns remain the same. I was wondering how to go about writing one. I've used the record macro feature with relative references enabled, but I can only get decent results using data that has the exact same number of rows. If I change the data and the number of rows I'm working with, the macro doesn't work properly. Maybe there's a tutorial for this sort of thing? That would help me out a lot.

Thanks! :)
 
I've got it working now to an extent:

Sub tryn()
' tryn Macro
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Cells.EntireColumn.AutoFit '<-- AUTOFIT all columns
ActiveWindow.FreezePanes = False
Range("A2").Select
ActiveWindow.FreezePanes = True '<--Freeze row 1

Columns("O").EntireColumn.Delete Shift:=xlToLeft '<-- Write the letter of the column you want to delete
Columns("M").EntireColumn.Delete Shift:=xlToLeft '<-- Write the letter of the column you want to delete
Columns("I").EntireColumn.Delete Shift:=xlToLeft '<-- Write the letter of the column you want to delete

Sheets(3).Delete '<---In my example this works - it's just deleting the third sheet to the right (I get how this is done now)

lr = Cells(Rows.Count, 8).End(xlUp).Row
Cells(lr + 1, 8).Value = "TOTAL"
Cells(lr + 1, 9).Value = WorksheetFunction.Sum(Range(Cells(2, 9), Cells(lr, 9)))

With Range(Cells(lr + 1, 8), Cells(lr + 1, 9)).Font
.Bold = True
.Color = -16776961
.TintAndShade = 0
.Name = "Arial"
.Size = 10
End With
With Sheets(2)
.Range("F:F").HorizontalAlignment = xlCenter
End With


End Sub





Using the above - I want to note that:
1. I want column F (aside from cell F1) to have the red text. As of now, it is being centered, but is not red. Column F is after the deletion of the three columns, of course (which the Macro is doing correctly).
2. I want the summation to have the 'Comma' style (currently, the number doesn't have any commas).
3. I will experiment with the fact that this one did not have a value for the total - some of the reports will have a total already on the sheet. Have to see how this affects the macro.
4. I want 'TOTAL' to be centered.
5. Is there a way, for example, to have the macro automatically delete rows based on a number in column F (after the deletion of the three columns)? Because I will probably only use rows that have a value of, for example, 1 or greater, or 30 or greater - either of those.

Thanks again for the assistance.
 
Last edited:
Upvote 0

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
Try this

Code:
Sub tryn()
' tryn Macro
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ActiveWindow.FreezePanes = False
    Range("A2").Select
    ActiveWindow.FreezePanes = True     '<--Freeze row 1
    
    Columns(15).EntireColumn.Delete Shift:=xlToLeft    '<-- Write the letter of the column you want to delete
    Columns(13).EntireColumn.Delete Shift:=xlToLeft    '<-- Write the letter of the column you want to delete
    Columns(9).EntireColumn.Delete Shift:=xlToLeft    '<-- Write the letter of the column you want to delete
    
    'Sheets(1).Delete
    
    With Columns("F").Font  'column "F" in Red
        .Bold = True
        .Color = -16776961
        .TintAndShade = 0
        .Name = "Arial"
        .Size = 10
    End With
    
    Columns("F:F").HorizontalAlignment = xlCenter
    
    lr = Cells(Rows.Count, 8).End(xlUp).Row
    Cells(lr + 1, 8).Value = "TOTAL"
    Cells(lr + 1, 8).HorizontalAlignment = xlCenter
    Cells(lr + 1, 9).Value = WorksheetFunction.Sum(Range(Cells(2, 9), Cells(lr, 9)))
    Cells(lr + 1, 9).NumberFormat = "#,##0.00"
    With Range(Cells(lr + 1, 8), Cells(lr + 1, 9)).Font
        .Bold = True
        .Color = -16776961
        .TintAndShade = 0
        .Name = "Arial"
        .Size = 10
    End With
    
    For i = lr To 2 Step -1
        If Cells(i, "F").Value < 1 Then
            Rows(i).Delete
        End If
    Next
    
    Cells.EntireColumn.AutoFit          '<-- AUTOFIT all columns
    
    MsgBox "End"
End Sub
 
Upvote 0
Tried with the sheet I've been using this entire time (has no total).

So everything's great - very nice - except for Cell F1 is still red - I want it to be the same as all the other headers (they export as bold and black).

I'm going to try this with one that has a total at the bottom - leaving work in 35 minutes though so may not get to it today.

Your help is appreciated.


Thanks so much.
 
Last edited:
Upvote 0
try this

Code:
Sub tryn()
' tryn Macro
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ActiveWindow.FreezePanes = False
    Range("A2").Select
    ActiveWindow.FreezePanes = True     '<--Freeze row 1
    
    Columns(15).EntireColumn.Delete Shift:=xlToLeft    '<-- Write the letter of the column you want to delete
    Columns(13).EntireColumn.Delete Shift:=xlToLeft    '<-- Write the letter of the column you want to delete
    Columns(9).EntireColumn.Delete Shift:=xlToLeft    '<-- Write the letter of the column you want to delete
    
    'Sheets(1).Delete
    
    lr = Cells(Rows.Count, 8).End(xlUp).Row
    With Range("F2:F" & lr).Font
        .Bold = True
        .Color = -16776961
        .TintAndShade = 0
        .Name = "Arial"
        .Size = 10
    End With
    
    Columns("F:F").HorizontalAlignment = xlCenter
    
    Cells(lr + 1, 8).Value = "TOTAL"
    Cells(lr + 1, 8).HorizontalAlignment = xlCenter
    Cells(lr + 1, 9).Value = WorksheetFunction.Sum(Range(Cells(2, 9), Cells(lr, 9)))
    Cells(lr + 1, 9).NumberFormat = "#,##0.00"
    With Range(Cells(lr + 1, 8), Cells(lr + 1, 9)).Font
        .Bold = True
        .Color = -16776961
        .TintAndShade = 0
        .Name = "Arial"
        .Size = 10
    End With
    
    For i = lr To 2 Step -1
        If Cells(i, "F").Value < 1 Then
            Rows(i).Delete
        End If
    Next
    
    Cells.EntireColumn.AutoFit          '<-- AUTOFIT all columns
    
    MsgBox "End"
End Sub
 
Upvote 0
One thing I've noticed with a new set of data that has a total in it and this formula about deleting things that don't have a value of 1 or greater is that the total summation will still sum the amounts that come from rows that are < 1 in column F. So the total it comes up with is incorrect.
 
Upvote 0
Another follow up:

If I switch the order and put the Delete < 1 part of the macro before the Sum column portion, then I get the correct total for sheets that don't have a total populated at the bottom of column I (after deletion of the 3 columns) - still this isn't 100% correct because there will be space between the data and the 'TOTAL' and its corresponding value.

And for sheets that do have a total populated at the bottom of column I (after deletion of the 3 columns), I get a total that includes the value of the total that showed up originally. So it's an incorrect total the macro is showing.

I'm thinking there needs to be some type of formula so the macro can distinguish between those two types (ones with a total at the bottom and ones without a total). I want one macro to work for both situations.

We're getting very close to this, but still some hangups.

Thanks so much, Dante.
 
Last edited:
Upvote 0
Also, I'd like to add a column header labeled 'COMMENTS' for column 'M' - this header needs to be bold, arial, 10, just like the other column headers. (this is column 'M' after deletion of the three columns).

Also, I want the entire spreadsheet centered. I think that would make things easier to look at.
 
Upvote 0
Try this

Code:
Sub tryn()
' tryn Macro
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ActiveWindow.FreezePanes = False
    Range("A2").Select
    ActiveWindow.FreezePanes = True     '<--Freeze row 1
    
    Columns(15).EntireColumn.Delete Shift:=xlToLeft    '<-- Write the letter of the column you want to delete
    Columns(13).EntireColumn.Delete Shift:=xlToLeft    '<-- Write the letter of the column you want to delete
    Columns(9).EntireColumn.Delete Shift:=xlToLeft    '<-- Write the letter of the column you want to delete
    
    'Sheets(1).Delete
    
    lr = Cells(Rows.Count, "I").End(xlUp).Row
    
    'delete lines
    For i = lr To 2 Step -1
        If Cells(i, "F").Value < 1 Then
            Rows(i).Delete
        End If
    Next
    
    lr = Cells(Rows.Count, "I").End(xlUp).Row
    With Range("F2:F" & lr).Font
        .Bold = True
        .Color = -16776961
        .TintAndShade = 0
        .Name = "Arial"
        .Size = 10
    End With
    
    Columns("F:F").HorizontalAlignment = xlCenter
    
    Cells(lr + 1, 8).Value = "TOTAL"
    Cells(lr + 1, 8).HorizontalAlignment = xlCenter
    Cells(lr + 1, 9).Value = WorksheetFunction.Sum(Range(Cells(2, 9), Cells(lr, 9)))
    Cells(lr + 1, 9).NumberFormat = "#,##0.00"
    With Range(Cells(lr + 1, 8), Cells(lr + 1, 9)).Font
        .Bold = True
        .Color = -16776961
        .TintAndShade = 0
        .Name = "Arial"
        .Size = 10
    End With
    
    With Cells(1, "M")
        .Value = "COMMENTS"
        .Font.Bold = True
        .Font.Name = "Arial"
        .Font.Size = 10
    End With
    
    Cells.EntireColumn.AutoFit          '<-- AUTOFIT all columns
    
    MsgBox "End"
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,324
Members
452,635
Latest member
laura12345

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top