Question

I’m working with excel 2007. I have an invoice system where I type in a purchase order number and it generates a new invoice with that p.o. number as the sheet name and also copies it to a cell on the same sheet, then from there it is manually filled out and saved. Each invoice has one of fourteen supply types (for example, Printing Supplies or Cleaning Supplies chosen from a dropdown list) in cell C6. That all works great.
I want to keep track of how much is spent on each supply type, so I need to go through every invoice, check for supply type and copy three non-contiguous cells (date (A6:B6), po# (F6:G6) and amount (G39)) to a row in the “checkbook style” sheet for that supply type.

I guess the pseudo code would look like this:

• For each sheet, check for supply type in cell c6
• If supply type is printing,
• write the three cell values in a new row to the sheet called Printing, otherwise go on to next
• if the supply type is cleaning,
• write the three cell values in a new row to the sheet called Cleaning
• and so forth, “if”ing myself to death.

Here is what I have that simply went through all sheets and copied the cells without sorting them by supply type – then I tried to get it to use just the Printing invoices with no success.

Sub CopyRangeFromPrintingWorksheets()


Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim CopyRng As Range

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With
'Delete the sheet "Printing" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("Printing").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "Printing"

'loop through all worksheets and copy the data to the DestSh
For Each sh In ActiveWorkbook.Worksheets
    'If sh.Name <> DestSh.Name Then
    If InStr(1, Worksheets(wks.Name).Range("C6:E6").Value, "Printing/Stationary 532-110", vbTextCompare) = 1 Then
    ' If LCase(Left(sh.Name, 4)) = "tly-" Then

        'Find the last row with data on the DestSh
        Last = LastRow(DestSh)

        'Fill in the range that you want to copy
        Set CopyRng = sh.Range("G3")


        'Test if there enough rows in the DestSh to copy all the data
        If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
            MsgBox "There are not enough rows in the Destsh"
            GoTo ExitTheSub
        End If

        'This copies values/formats, want to copy the
        'values or want to copy everything
        CopyRng.Copy
        With DestSh.Cells(Last + 1, "B")
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
        End With

        'Optional: This will copy the sheet name in the A column
        DestSh.Cells(Last + 1, "A").Resize(CopyRng.Rows.Count).Value = sh.Name
        'Copy ordered by cell to column C
        DestSh.Cells(Last + 1, "D").Resize(CopyRng.Rows.Count).Value = sh.Range("G39")
        'Copy date cell to proper column
        DestSh.Cells(Last + 1, "C").Resize(CopyRng.Rows.Count).Value = sh.Range("C6")
        DestSh.Cells(Last + 1, "E").Resize(CopyRng.Rows.Count).Value = sh.Range("E8")
    End If
Next

ExitTheSub:

Application.GoTo DestSh.Cells(1)

'AutoFit the column width in the DestSh sheet
DestSh.Columns.AutoFit

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

I even researched select case, but still have had no success. Tried recording a marco and looking at that code with no inspiration. This seems like it shouldn’t be that difficult…but I don’t know the most practical way to go about it. A pointer in the right direction would be fantastic!

Answer 1

Solving this in VBA is possible, but it’s going to be fairly cumbersome and brittle.

One problem with this approach is that you have data stored in multiple places that could get out of sync. Also, you want three different views of your data:

• single-record view (i.e., a single purchase order)
• multiple-record view (i.e., “checkbook style”), possibly grouped or filtered by supply type
• summary view (totals for a given date range and/or supply type)

This is fairly trivial to do in Access or a more serious database system, but a little searching leads me to believe that in Excel you can get two of the above but not all three. Nonetheless, the below links may help somewhat:

You can use a 3-d reference to sum data, but I don’t think you can create a pivot table from a 3-d reference (for a checkbook-style view):

http://office.microsoft.com/en-us/excel-help/create-a-3-d-reference-to-the-same-cell-range-on-multiple-worksheets-HP010102346.aspx

You can also consolidate multiple worksheets into a pivot table, but it looks like the source data must already be in checkbook-style view, so there’s no way to get a single-invoice view of the data:

http://office.microsoft.com/en-us/excel-help/consolidate-multiple-worksheets-into-one-pivottable-report-HA010226585.aspx

---

Bottom line: If you have some time to devote to this, I’d recommend moving the solution to Access.