You are here:

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

Advertisement

Good morning Damon,

Thank you for taking the time to look.

I would appreciate your help with the following or to know if it is even possible.

I am using Excel 2010 on Win7

Excel knowledge is basic, VBA very very basic.

Link to a copy of Intrastat workbook example http://1drv.ms/1N0wulF

I get data sent to me in a very scrambled order, I enter the data into the spreadsheet, then manually sort it into a different order, manually add some subtotals then print it, the data would now be is the order that I have to use to enter it onto an online government form.

I have created the Data Entry part of the form with the use of a table.

The second half of the form, columns J to O, have been typed in as an example of what I would like to achieve.

Could VBA do this?

I would like the second part of the sheet or another sheet if necessary, to contain the print version. This Print version would hold only the required (completed) data and would be sorted in a different order, an example can be seen in columns J to O of the sheet.

Thank you for looking,

Keith

Cornwall (UK)

Hello again Keith,

I finally got time to write that code--sorry about the delay. Here's a macro that generates the print table from the "scrambled" table. Please let me know if any problems. I've tested it with the data you provided, but of course one should always test with a wide range of data.

Here's the code:

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

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

Cells(iRow, "L").Formula = "=SubTotalAbove()"

Cells(iRow, "M").Formula = "=SubTotalAbove()"

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

Function TotalBlackValues(R As Range) As Double

' Totals cells in range R whose values are formatted the automatic (black) color

Dim C As Range 'an individual cell in the range R

TotalBlackValues = 0

For Each C In R

If IsNumeric(C) Then

If C.Font.ColorIndex = xlColorIndexAutomatic Then

TotalBlackValues = TotalBlackValues + C.Value

End If

End If

Next C

End Function

Function InsertRow(RowNum As Long)

' Inserts cells in row RowNum between columns J and O, shifting

' existing cells down.

Range(Cells(RowNum, "J"), Cells(RowNum, "O")).Insert shift:=xlDown

End Function

Function SubTotalAbove() As Double

'subtotals cells above the caller cell up to the the first empty cell

Dim C As Range 'a single cell

SubTotalAbove = 0

Set C = Application.Caller

Do

Set C = C.Offset(-1)

SubTotalAbove = SubTotalAbove + C.Value

Loop Until IsEmpty(C)

End Function

________________________________________________________________

As you can see, there are also several helper functions included, but you only need to run the MakePrintTable macro.

I hope you find this helpful, and it saves you a lot of time and tedium.

Damon

- Add to this Answer
- Ask a Question

Rating(1-10) | Knowledgeability = 10 | Clarity of Response = 10 | Politeness = 10 |

Comment | Thank you very much Damon for the extensive piece of code. It does mostly what I require and with a little tweeking, I think (because of your comments) I can get it to do ALL that is required. |

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.