Thread: Running total from mixed codes in Columns.

Hello trownson,

Welcome to the Forum!

Do you want to a button that will print the "ledger" for the selected company or would you like to create the "ledger" and have the option of printing?

Hello trownson,

So, you want running totals for each code. Do you still the ledger format for this?

Hello trownson,

I'll see what I can come up with and then have you look it over. We can make any needed changes afterward.

Hello trownson,

Do you have any other odd codes like "501/50" ? Would this follow code 400?

Hello trownson,

Here is the first draft of the ledger macro. The formatting stills needs a little work. Have a look a let me know if this close to what you wanted. I am including the macro code here for those who may be interested. This has already been added to the attached workbook.

Sub CreateLedger()

  Dim Cell As Range
  Dim Codes As Object
  Dim Key As Variant
  Dim R As Long
  Dim RowNum As Variant
  Dim Rng As Range
  Dim StartRow As Long
    
    With Worksheets("Template")
      Set Rng = .Range("E5:E25")
      Set Codes = CreateObject("Scripting.Dictionary")
      Codes.CompareMode = vbTextCompare
      
       'Save each code along with the rows where it is found
        For Each Cell In Rng
          Key = Trim(Cell)
          If Key <> "" Then
            If Not Codes.Exists(Key) Then
               Codes.Add Key, Cell.Row
            Else
               Codes(Key) = Codes(Key) & "," & Cell.Row
            End If
          End If
        Next Cell
      
     'Check that there are codes
      If Codes.Count = 0 Then Exit Sub
       
     'Use column "AA" as a helper column to sort the codes
      Set Rng = .Range("AA1:AA" & Codes.Count)
      Rng.Value = WorksheetFunction.Transpose(Codes.Keys)
      
     'Sort the codes in ascending order
      Rng.Sort Key1:=Rng.Cells(1, 1), Order1:=xlAscending, Header:=xlNo, _
               MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
      
    End With
    
    With Worksheets("Ledger")
      R = 1                            'Starting row on Ledger sheet
      .Cells.Clear
      
       'List the Codes and their entries
        For Each Key In Rng
         'Display the code number
          .Cells(R, "A").Font.Bold = True
          .Cells(R, "A").HorizontalAlignment = xlHAlignLeft
          .Cells(R, "A").Value = Key
          
         'All codes were saved as text. The worksheet range contains the original values.
          Key = CStr(Key)
          
          R = R + 2                    'Skip a line
          
          StartRow = R                 'Marks the first line entry of this code
          
           'Add the code entries
            For Each RowNum In Split(Codes(Key), ",")
              .Cells(R, "A").Resize(1, 7).Value = Worksheets("Template").Cells(RowNum, "A").Resize(1, 7).Value
              R = R + 1
            Next RowNum
            
          R = R + 1                    'Skip a line
          
         'Add the Total Line and Sum formula
          With .Cells(R, "A").Resize(1, 7).Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
          End With
          .Cells(R, "A").Font.Bold = True
          .Cells(R, "A").Value = "TOTAL"
          .Cells(R, "G").Font.Bold = True
          
          .Cells(R, "G").Formula = "=Sum(G" & StartRow & ":G" & R - 2 & ")"
          
          R = R + 3                    'Skip 2 lines between codes
        Next Key
        
    End With
    
End Sub