You are here:

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

Advertisement


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

Answer
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  
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

Excel

All Answers


Answers by Expert:


Ask Experts

Volunteer


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.

©2016 About.com. All rights reserved.