I have a table containing data of sold products (shown in the example on the left):

Number of the order
Product Name
Attribute - specifies what is given in the following field "value", e. g. Customer Name or Product Variant
Value - is the value of the Attribute
Count - is the number of products of this variant sold in the order

Screenshot of example

That means: Product B has 2 variants "c" and "d" Note that in Order 1 Product B was sold in Variant d only, because the letter "N" in field "D4" means "none". Note, that in OrdnerNo 3 Product B was sold only in Variant c, because for Variant d field "D9" is "N"!! This is confusing, but it is the structure of the original data (which I can not change).

I need a way to convert the table on the left in a table like that on the right:

  • one line for each product type
  • Order Number
  • Product Name
  • Customer Name
  • Count (number of products sold in this order)
  • Variant - this is the problem, as it has to be filled with the

So all rows with the same OrderNo and same product have to be grouped in to one, and

I hope it is clear what I need. I tried to do it with Pivot Tables, but that fails, as the Count is always in each line, no matter if it has Value "N" or not and for the products without variants there is only one line for each order, however for products with variants there are several...

So how could I create the right table with a VBA macro in MS Excel or maybe there is a trick in MS Access to do it directly or with an SQL query?

  • where does your data come from? a database? – Joseph Dec 7 '12 at 19:20
  • yes, but i dont have direct access to tfe db, just the list – MostlyHarmless Dec 8 '12 at 8:28
  • 1
    ok. is it safe to say you can completely ignore any row with N for the value column? – Joseph Dec 8 '12 at 16:54
  • @joseph4tw: yes, that should be safe. In reality, there will be also many other attributes, which can be ignored, but I can filter them out before converting the table. Thanks a lot for your answer and your code - I'll try that and give you feedback – MostlyHarmless Dec 8 '12 at 23:20
  • you're very welcome! If you have any questions about adding conditions or how the code works please let me know. – Joseph Dec 9 '12 at 18:36

This was pretty confusing, but I got it. Paste the code into the module. Make sure you're on the main sheet to do the evaluating and run transformTable().

Here's more/less how it works:

  • Go through the list
  • Ignore any row with N in the Value column
  • Create a collection of orders
  • If an order already exists (based on OrderNo, Product, and Count), then add info to it (like customer or variant info)
  • Then loop through the collection of orders and print it out on a new sheet

Hope you like it.

Option Explicit

Public Type OrderInfo
    orderNo As Long
    product As String
    customer As String
    productVariant As String
    producctVariantName As String
    productCount As Long
End Type

Public Sub transformTable()
    Dim sh As Excel.Worksheet
    Dim orders() As OrderInfo

    Set sh = ActiveSheet
    orders = buildOrders(sh)
    Call createNewTable(orders)
End Sub

Private Sub createNewTable(ByRef orders() As OrderInfo)
    Application.ScreenUpdating = False

    Dim wb As Excel.Workbook
    Dim newSh As Excel.Worksheet
    Dim i As Long
    Dim curRow As Long

    curRow = 2
    Set wb = ThisWorkbook
    Set newSh = wb.Worksheets.Add

    newSh.Range("A1:F1").Value = Array("OrderNo", "Product", "Cust", "Count", "Variant", "Variant Name")

    For i = LBound(orders) To UBound(orders)
        newSh.Cells(curRow, "A").Value = orders(i).orderNo
        newSh.Cells(curRow, "B").Value = orders(i).product
        newSh.Cells(curRow, "C").Value = orders(i).customer
        newSh.Cells(curRow, "D").Value = orders(i).productCount
        newSh.Cells(curRow, "E").Value = orders(i).productVariant
        newSh.Cells(curRow, "F").Value = orders(i).producctVariantName

        curRow = curRow + 1
    Next i
    Application.ScreenUpdating = True
End Sub

Private Function buildOrders(ByRef sh As Excel.Worksheet) As OrderInfo()
    Dim lastRow As Long
    Dim i As Long
    Dim index As Long
    Dim indexFound As Long
    Dim orders() As OrderInfo

    lastRow = sh.Cells(sh.Rows.Count, 1).End(xlUp).Row
    ReDim orders(0)

    If (lastRow <= 1) Then
        buildOrders = orders
        Exit Function
    End If

    For i = 2 To lastRow
        If (sh.Cells(i, "D").Value <> "N") Then
            indexFound = findIndex(orders, sh.Cells(i, "A").Value, sh.Cells(i, "B").Value, sh.Cells(i, "E").Value)

            If (indexFound = -1) Then
                ' add new orderInfo
                ReDim Preserve orders(index)
                If (sh.Cells(i, "C").Value = "Cust") Then
                    orders(index) = createOrderInfo(sh.Cells(i, "A").Value _
                                            , sh.Cells(i, "B").Value _
                                            , sh.Cells(i, "E").Value _
                                            , sh.Cells(i, "D").Value)
                ElseIf (InStr(1, sh.Cells(i, "C").Value, "Variant", vbTextCompare) > 0) Then
                    orders(index) = createOrderInfo(sh.Cells(i, "A").Value _
                                            , sh.Cells(i, "B").Value _
                                            , sh.Cells(i, "E").Value _
                                            , productVariant:=Right(sh.Cells(i, "C").Value, 1) _
                                            , productVariantName:=sh.Cells(i, "D").Value)
                End If
                index = index + 1
                ' add customer or variant
                If (sh.Cells(i, "C").Value = "Cust") Then
                    orders(indexFound).customer = sh.Cells(i, "D").Value
                ElseIf (InStr(1, sh.Cells(i, "C").Value, "Variant", vbTextCompare) > 0) Then
                    orders(indexFound).productVariant = Right(sh.Cells(i, "C").Value, 1)
                    orders(indexFound).producctVariantName = sh.Cells(i, "D").Value
                End If
            End If

        End If

    Next i

    buildOrders = orders
End Function

Private Function createOrderInfo(ByVal orderNo As Long _
                                , ByRef product As String _
                                , ByVal productCount As Long _
                                , Optional ByRef customer As String = "" _
                                , Optional ByRef productVariant As String = "" _
                                , Optional ByRef productVariantName As String = "") As OrderInfo

    Dim oi As OrderInfo
    oi.orderNo = orderNo
    oi.product = product
    oi.productCount = productCount
    oi.customer = customer
    oi.productVariant = productVariant
    oi.producctVariantName = productVariantName

    createOrderInfo = oi
End Function

Private Function findIndex(ByRef orders() As OrderInfo _
                            , ByVal orderNo As Long _
                            , ByRef product As String _
                            , ByVal productCount As Long) As Long
    Dim i As Long

    For i = LBound(orders) To UBound(orders)
        If (orders(i).orderNo = orderNo And orders(i).product = product And orders(i).productCount = productCount) Then
            findIndex = i
            Exit Function
        End If
    Next i

    findIndex = -1
End Function

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.