You are here:

- Home
- Computing/Technology
- Business Software
- Excel
- Enter data in one format but print in another format.

Advertisement

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

'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

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

'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

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

- Add to this Answer
- Ask a Question

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

Excel

Answers by Expert:

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.**Education/Credentials**

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