You are here:

Excel/Enter data in one format but print in another format.


Hi Damon
I have used the same title as you will be able to refer to the whole question.

You wrote quite a bit of code for me that I have been “playing” with, it has helped me to understand it better and learn a lot more to get it to do more of what I would like.

I have come across a problem that I have spent a lot of hours on trying to solve with no luck.

When running through the code, the event runs through each of the "=SubTotalAbove()" lines below.

'Now look for subtotal spacer lines and add subtotals
 LRow = Range("J65536").End(xlUp).Row
For iRow = 6 To LRow
    'if CC is empty and previous CC is gray then subtotal row
    If IsEmpty(Cells(iRow, "J")) And Cells(iRow - 1, "J").Font.ColorIndex = 16 Then
       'iRow is Subtotal row
       Cells(iRow, "J") = Cells(iRow - 1, "J")
       Cells(iRow, "K").Formula = "=SubTotalAbove()" << Here
       Cells(iRow, "L").Formula = "=SubTotalAbove()" << Here
       Cells(iRow, "M").Formula = "=SubTotalAbove()" << and Here
       Range(Cells(iRow, "J"), Cells(iRow, "O")).Font.ColorIndex = xlColorIndexAutomatic
    End If
 Next iRow

I am assuming that when each line has run, the code should then go down and execute ,

Function SubTotalAbove() As Double
before executing the next "=SubTotalAbove()"

I am "almost" sure it did do this once, but now, no matter how much I try, I can't achieve it again, perhaps I am mistaken.

Again, your guidance would be much appreciated,
So far as I can tell, with the testing and extra data added, “everything” else seems to be working great.

Hi Keith,

Yes, I didn't design the code to generate a sheet that would update via formulas when the data is changed.  The following modified code for the main (MakePrintTable) procedure should solve that problem.  This version does not use the SubTotalAbove function.

Sub MakePrintTable()
  Dim iRow    As Long     'row of input table
  Dim LRow    As Long     'last input data row
  Dim oRow    As Long     'row in printer table
  Dim InGroup As Boolean
  'Put headers on Printer table
  Range("J2") = "Trip No":      Range("K2") = Range("E1")
  Range("J3") = "Date":         Range("K3") = Range("E2")
  Range("J4") = "Value":        Range("K4") = Range("E3")
  Range("L1") = "Ex Rate":      Range("M1") = Range("G1")
  Range("N1") = "Species":      Range("O4") = Range("E4")
  Range("N2") = "Vessel Name":  Range("O2") = Range("A2")
  'put border around headers
  Dim i    As Integer
  With Range("J1:O4")
     For i = xlEdgeLeft To xlEdgeRight
        .Borders(i).ColorIndex = 0
     Next i
  End With
  iRow = 6
  oRow = 6
  LRow = Cells(65536, "D").End(xlUp).Row
     If Not IsEmpty(Cells(iRow, "D")) Then
        'iRow has data in column D, so transfer data
        'to printer table
        Cells(oRow, "J") = Cells(iRow, "C") 'Commodity Code
        Cells(oRow, "K") = Cells(iRow, "G") 'Total £
        Cells(oRow, "L") = Cells(iRow, "D") 'Kilos
        Cells(oRow, "M") = Cells(iRow, "F") 'Total €
        Cells(oRow, "N") = Cells(iRow, "B") 'British Name
        Cells(oRow, "O") = Cells(iRow, "A") 'French Name
        oRow = oRow + 1
     End If
     iRow = iRow + 1
  Loop Until iRow > LRow
  'sort print table by Commodity Code
  Range("J6", Cells(oRow, "O")).Sort Range("J6")
  'loop rows upward in the Printer table to separate CC groups
  InGroup = False
     oRow = oRow - 1
     'Check rows for same CC
     If Cells(oRow, "J") = Cells(oRow - 1, "J") Then
        'gray font rows in group
        Range(Cells(oRow, "J"), Cells(oRow, "O")).Font.ColorIndex = 16
        If Not InGroup Then
         InGroup = True
         'add extra rows for subtotal and spacer
         InsertRow oRow + 1
         If Not IsEmpty(Cells(oRow + 2, "J")) Then InsertRow oRow + 1
        End If
        If InGroup Then
         Range(Cells(oRow, "J"), Cells(oRow, "O")).Font.ColorIndex = 16
         'end of group
         'add a spacer row
         InsertRow oRow
         InGroup = False
        End If
     End If
  Loop Until oRow < 6
  'Now look for subtotal spacer lines and add subtotals
  LRow = Range("J65536").End(xlUp).Row
  Dim fRow    As Long
  For iRow = 6 To LRow
     'if CC is empty and previous CC is gray then subtotal row
     If IsEmpty(Cells(iRow, "J")) And Cells(iRow - 1, "J").Font.ColorIndex = 16 Then
        'iRow is Subtotal row
        'find first row to subtotal
        fRow = iRow - 1
        Do Until IsEmpty(Cells(fRow, "J"))
         fRow = fRow - 1
        fRow = fRow + 1
        Cells(iRow, "J") = Cells(iRow - 1, "J")
        Cells(iRow, "K").Formula = "=SUM(K" & fRow & ":K" & iRow - 1 & ")"
        Cells(iRow, "L").Formula = "=SUM(L" & fRow & ":L" & iRow - 1 & ")"
        Cells(iRow, "M").Formula = "=SUM(M" & fRow & ":M" & iRow - 1 & ")"
        Range(Cells(iRow, "J"), Cells(iRow, "O")).Font.ColorIndex = xlColorIndexAutomatic
     End If
  Next iRow
  'Format columns K:M two decimals
  Range("K6:M100").NumberFormat = "#.##"
  'Add totals in columns K:M at bottom of table
  Dim iCol As Integer
  For iCol = 11 To 13   'K to M
     Cells(LRow + 2, iCol) = TotalBlackValues(Range(Cells(LRow, iCol), Cells(6, iCol)))
  Next iCol
  'put borders around total cells
  With Range(Cells(LRow + 2, "K"), Cells(LRow + 2, "M"))
     For i = xlEdgeLeft To xlEdgeRight
        .Borders(i).ColorIndex = 0
     Next i
  End With
End Sub

Again, let me know if any problem.

About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here


All Answers

Answers by Expert:

Ask Experts


Damon Ostrander


I have extensive experience with VBA programming in Excel 5 through Excel 2013. As a former aerospace engineer with a large aerospace corporation and consultant in a small defense technology services company, I have developed a wide range of applications in VBA, including simulations involving mixed-language programming, satellite orbit mechanics, graphics and animation, and real-time applications. I am interested in moderate to hard VBA-related questions only.


I have developed and taught several courses in Excel VBA programming and also VBA programming in Office 97, 2000, and 2007. I have developed a number of large technical applications in Excel VBA for use within the aerospace industry.

B.S. in Electrical Engineering and Computer Science, University of California, Berkeley.

©2016 All rights reserved.