You are here:

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

Question
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,
Keith
PS
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

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")

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

Do
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
Do
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
Else
If InGroup Then
Range(Cells(oRow, "J"), Cells(oRow, "O")).Font.ColorIndex = 16
'end of group
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
Loop
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.

Damon
Questioner's Rating
 Rating(1-10) Knowledgeability = 10 Clarity of Response = 10 Politeness = 10 Comment Hi again Damon, Thank you for the new code, I have tested it and will continue testing it along with all the other bits and pieces I have on this spreadsheet to see that each dose not adversely affect the other. So far no conflicts everything is working well. Once again, I thank you for your time and effort, without people like yourself, these communities would not exist. Much appreciated, Keith

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

#### Damon Ostrander

##### Expertise

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.

##### Experience

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.

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