Relative cell reference for summing

[poldim]

Here is my dilemma:
I am given data that looks like this:

I need to make it look like this:

This is one of about 25 sheets in one excel file, and I will be receiving about 5 different files a week, so a macro is necessary to save time. I tried to create a macro just by recording, and it was not able to adjust to the variances in the number of lines between the sheets.

I need it to do the following, and more or less in this order:
-Delete Column A
-Create text and format A1:C1
-Sort rows 2 through the last row based on column C values (from largest to smallest, although its not shown in the picture above)
-Create a sum at the bottom
-Apply grid lines to all the data


I don't have a problem with the first two, but I cannot figure out how to adjust for the number of rows for sorting, offset 1 cell down to create the sum formula below the data, or how to properly write the macro for the sum formula itself. When I recorded the macro, it used cell references like Range("C5").Select and others which do not adapt to the varying number of rows.

I tried using the offset command in this thread without much luck.

This is some of the macro I have:

    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Customer ID"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Customer Name"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Year to Date - Dec 12"
    Range("A1").Activate
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    ActiveWorkbook.Worksheets("20117").Sort.SortFields.Add Key:=Range("C2:C10"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("20117").Sort
        .SetRange Range("A1:C10")
        .Header = xlYes
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Rows("1:1").Select
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
    End With
    Range("A1:C1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .TintAndShade = -0.249977111117893
    End With

If someone could explain how to properly do this, it would be greatly appreciated.

 

[DonkeyOte]

Welcome to the Board.

Probably not the most efficient method but perhaps something along the lines of:

Public Sub Reformat_Data()
Dim ws As Worksheet, rng1 As Range, border_i As Long
Set ws = Sheets("data1")
ws.Columns(1).Delete
ws.Cells(1, 1) = "Customer ID"
ws.Cells(1, 2) = "Customer Name"
ws.Cells(1, 3) = "Year to Date - Sept 07"
Set rng1 = ws.UsedRange
With rng1.Rows(1)
    .Font.Bold = True
    .HorizontalAlignment = xlCenter
    .Interior.Pattern = xlSolid
    .Interior.TintAndShade = -0.249977111117893
End With
rng1.Sort Key1:=rng1.Columns(3), order1:=xlDescending, Header:=xlYes
Set rng1 = rng1.Resize(rng1.Rows.Count + 1, rng1.Columns.Count)
Cells(rng1.Rows.Count, rng1.Columns.Count).FormulaR1C1 = "=SUM(R2C:R[-1]C)"
For border_i = 1 To 4 Step 1
    With rng1.Borders(border_i)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
Next border_i
rng1.Columns.AutoFit
Set rng1 = Nothing
Set ws = Nothing
End Sub

The above is set to work on one given sheet (set via text in red -- ie the sheet name) though you can of course process multiple sheets at once either by holding the sheet names in an array and looping them or alternatively by "grouping" the sheets (CTRL + click) before invoking the routine and adding some code to iterate each selected sheet in the active window... we would need to know what your plans are in terms of running this code.... if the sheet names are fixed I would use a pre-set array else I would go for the grouped sheets method.

 

[poldim]

Thanks for the help, this worked perfectly for any sheet I put in the data1 place. I tried to make an array from this thread but get a compile error, I was just practicing with two sheets:

Public Sub Reformat_Data()
'    Dim ws As Worksheet, rng1 As Range, border_i As Long
'    Set ws = Sheets(Array(18161, 19060))
    Dim ws As Sheets, wsSheet As Worksheet, rng1 As Range, border_i As Long
    Set ws = Worksheets(Array("18161", "19060"))
    For Each ws In SheetArray
        ws.Columns(1).Delete
        ws.Cells(1, 1) = "Customer ID"
        ws.Cells(1, 2) = "Customer Name"
        ws.Cells(1, 3) = "Year to Date - Sept 07"
        Set rng1 = ws.UsedRange
        With rng1.Rows(1)
            .Font.Bold = True
            .HorizontalAlignment = xlCenter
            .Interior.Pattern = xlSolid
            .Interior.TintAndShade = -0.249977111117893
        End With
        rng1.Sort Key1:=rng1.Columns(3), order1:=xlDescending, Header:=xlYes
        Set rng1 = rng1.Resize(rng1.Rows.Count + 1, rng1.Columns.Count)
        Cells(rng1.Rows.Count, rng1.Columns.Count).FormulaR1C1 = "=SUM(R2C:R[-1]C)"
        For border_i = 1 To 4 Step 1
            With rng1.Borders(border_i)
                .LineStyle = xlContinuous
                .Weight = xlThin
            End With
        Next border_i
        rng1.Columns.AutoFit
        Set rng1 = Nothing
        Set ws = Nothing
    Next
End Sub

These are the sheet, so an array is necessary:

12090, 12536, 15014, 16417, 18161, 19060, 20117, 23025, 23311, 23909, 25211, 25721, 26007, 26140, 26141, 26142, 26203, 28175, 32899, 57965, 67829, 71572, 90012, 90018, 90034, 90044, 90092, 90098, 90175, 90224, 90226, 90229, 90295, 90303, 90372, 90587, 90589, 90599, 90621, 90842, 90916, 91050, 91092, 91571, 91575, 91600, 91750

On a side note, is there an easy way to split / export / separate the workbook by each individual sheet and save it to a folder on my hard drive with this array loop?

 

[DonkeyOte]

You have your variables slightly mixed up which is causing you the issue... in your ex. you have defined:

ws: to be the array
wsSheet: to be an individual sheet

in which case you must loop the array by individual sheet, eg:

For Each wsSheet in ws
...do stuff
Next  wsSheet

However the above would require that you alter every subsequent reference to ws from the original code to be wsSheet... a pain and in truth ws is often used by coders to represent a singular worksheet.

Below is a revised version of the original...

Public Sub Reformat_Data()
Dim ws As Worksheet, wsArray As Sheets, rng1 As Range, border_i As Long
Set wsArray = Worksheets(Array("12090", "12536", "15014", "16417", "18161", "19060", "20117", _
                                "23025", "23311", "23909", "25211", "25721", "26007", "26140", _
                                "26141", "26142", "26203", "28175", "32899", "57965", "67829", _
                                "71572", "90012", "90018", "90034", "90044", "90092", "90098", _
                                "90175", "90224", "90226", "90229", "90295", "90303", "90372", _
                                "90587", "90589", "90599", "90621", "90842", "90916", "91050", _
                                "91092", "91571", "91575", "91600", "91750"))
For Each ws In wsArray
    ws.Columns(1).Delete
    ws.Cells(1, 1) = "Customer ID"
    ws.Cells(1, 2) = "Customer Name"
    ws.Cells(1, 3) = "Year to Date - Sept 07"
    Set rng1 = ws.UsedRange
    With rng1.Rows(1)
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .Interior.Pattern = xlSolid
        .Interior.TintAndShade = -0.249977111117893
    End With
    rng1.Sort Key1:=rng1.Columns(3), order1:=xlDescending, Header:=xlYes
    Set rng1 = rng1.Resize(rng1.Rows.Count + 1, rng1.Columns.Count)
    ws.Cells(rng1.Rows.Count, rng1.Columns.Count).FormulaR1C1 = "=SUM(R2C:R[-1]C)"
    For border_i = 1 To 4 Step 1
        With rng1.Borders(border_i)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
    Next border_i
    rng1.Columns.AutoFit
    Set rng1 = Nothing
    Set ws = Nothing
Next
End Sub

note there is one further change to my original code (other than the creation and iteration of the sheets array) which was that in the original code I had not preceded the formula entry with "ws." which would not always generate correct results, this was an oversight on my part.

 

[poldim]

Thanks, works flawlessly!!!!

If you're ever in the San Francisco area, let me know, I owe you a beer or two...

Is there an easy way to split / export / separate the workbook by each individual sheet and save it to a folder on my hard drive with this array loop?

 

[DonkeyOte]

Public Sub Reformat_Data()
Dim ws As Worksheet, wsArray As Sheets, rng1 As Range, border_i As Long
Dim fldr As String: fldr = "C:\MrE\poldim\"
Application.ScreenUpdating = False
Set wsArray = Worksheets(Array("12090", "12536", "15014", "16417", "18161", "19060", "20117", _
                                "23025", "23311", "23909", "25211", "25721", "26007", "26140", _
                                "26141", "26142", "26203", "28175", "32899", "57965", "67829", _
                                "71572", "90012", "90018", "90034", "90044", "90092", "90098", _
                                "90175", "90224", "90226", "90229", "90295", "90303", "90372", _
                                "90587", "90589", "90599", "90621", "90842", "90916", "91050", _
                                "91092", "91571", "91575", "91600", "91750"))
For Each ws In wsArray
    ws.Columns(1).Delete
    ws.Cells(1, 1) = "Customer ID"
    ws.Cells(1, 2) = "Customer Name"
    ws.Cells(1, 3) = "Year to Date - Sept 07"
    Set rng1 = ws.UsedRange
    With rng1.Rows(1)
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .Interior.Pattern = xlSolid
        .Interior.TintAndShade = -0.249977111117893
    End With
    rng1.Sort Key1:=rng1.Columns(3), order1:=xlDescending, Header:=xlYes
    Set rng1 = rng1.Resize(rng1.Rows.Count + 1, rng1.Columns.Count)
    ws.Cells(rng1.Rows.Count, rng1.Columns.Count).FormulaR1C1 = "=SUM(R2C:R[-1]C)"
    For border_i = 1 To 4 Step 1
        With rng1.Borders(border_i)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
    Next border_i
    rng1.Columns.AutoFit
    ws.Copy
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs fldr & ws.Name & ".xls"
    ActiveWorkbook.Close
    Application.DisplayAlerts = True
    Set rng1 = Nothing
    Set ws = Nothing
Next
Application.ScreenUpdating = True
End Sub

additional code highlighted in red... that in bold (fldr) -- change to be the folder in which the individual files are to be stored... you could use a dialog to get this via navigation if it will alter regularly... if always the same just amend the above (C:\MrE\poldim\") to be whatever you wish to use.

 

[poldim]

DonkeyOte,

When I ran this, I was not able to open the file in Excel 2003 (it was created in Excel 2007). Is there something special that has to be modified in order to make it backwards compatible?

 

[DonkeyOte]

You mean you run the saveas routine from a 2007 file but then try to open the generated files from 2003 ?

Try adding the code in red:

ActiveWorkbook.SaveAs fldr & ws.Name & ".xls", FileFormat:=xlExcel8 

I can't say I've tested this functionality myself as I'm afraid I don't have a 2003 version readily available (it's on another machine which is turned off presently) ... on an aside, do any of the sheets you're copying exceed 2003 limitations ?
(eg > 256 columns or > 65536 rows of data)

 

[poldim]

You mean you run the saveas routine from a 2007 file but then try to open the generated files from 2003 ?

Try adding the code in red:

ActiveWorkbook.SaveAs fldr & ws.Name & ".xls", FileFormat:=xlExcel8 

I can't say I've tested this functionality myself as I'm afraid I don't have a 2003 version readily available (it's on another machine which is turned off presently) ... on an aside, do any of the sheets you're copying exceed 2003 limitations ?
(eg > 256 columns or > 65536 rows of data)

Thanks again!

I havent been able to test this out, but I will when I return from vacation. Is there a website or a help menu that lists the VBA function and possible operations? I was obviously using an incorrect one, but could not readily find a listing of possibilities.

 

[DonkeyOte]

Not entirely sure I follow what you're asking etc...

You have obviously a few resources readily available:

-- XL Help (native & VBA)
-- VBA Object Browser
-- VBA's assistance in terms of "Help" when you being typing in a command etc (the various arguments that can be utilised are listed)
-- The Macro Recorder

People often under use the Macro Recorder once they feel they are comfortable coding from scratch... the Recorder can still be an invaluable resource for finding out the appropriate code to do some action or other if you're unsure... the Macro Recorder will normally show you all the possible "subactions" related to the parent action -- most of which you won't need to use but it will show the important bits & pieces.

And of course...

-- MrExcel.com

There is no better resource than a 105,000+ strong worldwide XL community... if you search the Forum you will find what you need.

Have a good vacation.