Time Saving Techniques?

Hello Xelpme,

This macro sorts the data first to group all the same numbers together. It creates a table for each set of numbers and their totals (Price and Cost). The totals are in bold, and each table is seperated by 2 blank lines. See the attachment for how the table is formatted. After you insert a Standard VBA Module into your workbook, copy and paste the macro code into it. You can then assign it to a command button or run it using ALT+F8. The worksheet names in the macro Sheet1 and Sheet2. Sheet1 has the data, and Sheet2 is were the tables are created. Things can be changed to the names you are using. It looks long because of all the formatting code, but it works quite fast.

'Author: Leith Ross

Option Explicit

Sub CreateTotalTables()

  Dim HeaderRng As Range
  Dim LastRowSrc As Long
  Dim NewRowDst As Long
  Dim R As Long
  Dim TopRowDst As Long
  Dim TotalCost As Variant
  Dim TotalPrice As Variant
  Dim WksSrc As Worksheet
  Dim WksDst As Worksheet
     
    Set WksSrc = Worksheets("Sheet1")
    Set WksDst = Worksheets("Sheet2")
    
    WksDst.UsedRange.Clear
        
    With WksSrc
      .Activate
      Set HeaderRng = .Range("A1:E1")
      LastRowSrc = .Cells(.Rows.Count, "A").End(xlUp).Row
        With .Range(.Cells(2, "A"), .Cells(LastRowSrc, "E"))
          .Sort Key1:=.Cells(1, "A")
        End With
    End With
     
    R = 1
    NewRowDst = 1
    GoTo AddHeader
    
    Do While R < LastRowSrc + 1
      NewRowDst = NewRowDst + 1
      WksSrc.Range("A" & R).Resize(1, 5).Copy Destination:=WksDst.Range("A" & NewRowDst)
       'Sum the totals for Price and Cost
        TotalPrice = TotalPrice + WksSrc.Cells(R, "D")
        TotalCost = TotalCost + WksSrc.Cells(R, "E")
          If WksSrc.Cells(R, "A") <> WksSrc.Cells(R + 1, "A") Then
             WksSrc.Range("A" & R).Resize(1, 5).Copy Destination:=WksDst.Range("A" & NewRowDst)
             NewRowDst = NewRowDst + 1
              'Add inside column lines
                 With WksDst.Range("A" & TopRowDst & ":E" & NewRowDst - 1).Borders(xlInsideVertical)
                   .Weight = xlThin
                   .LineStyle = xlContinuous
                 End With
               'Add border around table
                 With WksDst.Range("A" & TopRowDst & ":E" & NewRowDst)
                   .BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
                 End With
               'Add double line above totals
                 With WksDst.Range("A" & NewRowDst).Resize(1, 5)
                   With .Borders(xlEdgeTop)
                     .Weight = xlThin
                     .LineStyle = xlDouble
                   End With
                 'Display totals in Bold
                   .Font.Bold = True
                   .Cells(1, 2).Value = "Totals"
                   .Cells(1, 4).Value = Format(TotalPrice, "currency")
                   .Cells(1, 5).Value = Format(TotalCost, "currency")
                 End With
               'Add separator lines between total columns
                 With WksDst.Range("D" & NewRowDst)
                   With .Borders(xlEdgeLeft)
                     .Weight = xlThin
                     .LineStyle = xlContinuous
                   End With
                   With .Borders(xlEdgeRight)
                     .Weight = xlThin
                     .LineStyle = xlContinuous
                   End With
                 End With
               TotalCost = 0
               TotalPrice = 0
             NewRowDst = NewRowDst + 3
AddHeader:
           'Add bottom border to header labels
            HeaderRng.Copy Destination:=WksDst.Range("A" & NewRowDst)
              With WksDst.Range("A" & NewRowDst).Resize(1, 5).Borders(xlEdgeBottom)
                .Weight = xlMedium
                .LineStyle = xlContinuous
              End With
            TopRowDst = NewRowDst
          End If
      R = R + 1
    Loop
    
   'Delete last header
    WksDst.Range("A" & NewRowDst).Resize(1, 5).Clear
    
End Sub

Sincerely,
Leith Ross

mudraker,

Sorry about breaking a forum rule regarding formatting of code.

Thank you for your coding expertise. I tried your code and it works well, I have been playing around with it trying to tinker it to my design but cannot work out how to do so.

All I want to know regards formatting so:
1. Each table is separated by a blank row.
2. Each table is surrounded by the "All Borders" option.
3. At the bottom row of each table, before the total columns, there are 3blank cells, I just want to fill this with a colour such as grey, I also need this for another blank cell on the same bottom row of each table for a column after the cost.
4. Each heading in each table has a grey background with white bold font for any font but default.

Also, there are times when some numbers in the No column contain an additional letter and need to be grouped together with this same number. E.g. 10, 10f, 10g, all should belong to the same separate table.

Finally a personal question. How long have you been working with Excel to gain the expertise to write this code? I would love to write it myself but haven't the time.

Thanks again for your knowledge.





Leith Ross,

I tried your code but nothing happened at all. Thank you for your time though.

Hello Xelpme,

If you post your workbook I'll install the macro for you. If you can't post the workbook, due to your location or confidentiality, post a larger sample of data that I can use. I will create a workbook from that with the macro it so you can see how it runs.

Sincerely,
Leith Ross