Announcement

Collapse
No announcement yet.

10USD: Excel VBA Input table to another format table

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • 10USD: Excel VBA Input table to another format table



    I have a simple table which I wanted to transfer to another format by using Excel VBA.
    It should run to select all records on input sheet and have it output.

    Please find my input sheet and the output should be as per the output sheet.
    Transaction ID: 22831538RS982110G

    Attached Files

  • #2
    If you are okay with a formula based solution (requires a helper column in the input sheet) then let me know...
    Where there is a will there are many ways. Finding one that works for you is the challenge!

    MS Excel MVP 2010-2016

    Comment


    • #3
      Originally posted by NBVC View Post
      If you are okay with a formula based solution (requires a helper column in the input sheet) then let me know...
      NBVC, Thanks, but i prefer to have a VBA, since its slows down when a lot of formula on the cell.

      Comment


      • #4
        Ok. No problem..

        then the thread is released for others to take.
        Where there is a will there are many ways. Finding one that works for you is the challenge!

        MS Excel MVP 2010-2016

        Comment


        • #5
          Hi,
          I can help you with your request. I'll look into it.
          GC

          Comment


          • #6
            Hello again,
            I have a solution ready. I will post the code here once payment is received. I'll send you my email via PM.

            GC

            Comment


            • #7
              Originally posted by GCExcel View Post
              Hello again,
              I have a solution ready. I will post the code here once payment is received. I'll send you my email via PM.
              GC
              Thanks. Payment sent.

              Comment


              • #8
                Payment received. Thanks !

                Here's the code. Let me know if you have any questions.

                Code:
                Sub UnpivotData()
                   Dim arD, arO
                   Dim i As Long, ii As Long, n As Long
                   
                   Application.ScreenUpdating = False
                   
                   'Input and Output arrays
                   arD = Sheets("input").Cells(1).CurrentRegion.Value
                   ReDim arO(1 To UBound(arD, 1) * UBound(arD, 2), 1 To 5)
                    
                   'Get data and unpivot
                   For i = 2 To UBound(arD, 1)
                      If Application.CountA(Application.Index(arD, i, 0)) > 3 Then
                         For ii = 4 To UBound(arD, 2)
                            If arD(i, ii) <> "" Then
                               n = n + 1
                               arO(n, 1) = arD(i, 1) 'Item
                               arO(n, 2) = arD(i, 2) 'Color
                               arO(n, 3) = arD(i, 3) 'Price
                               arO(n, 4) = arD(1, ii) 'Size
                               arO(n, 5) = arD(i, ii) 'Quantity
                            End If
                         Next
                      End If
                   Next
                   
                   'Output unpivot array
                   With Sheets("output").Cells(1).CurrentRegion
                      .Clear
                      With .Resize(, UBound(arO, 2))
                         .Value = [{"ITEM","COLOUR","PRICE","SIZE","QUANTITY"}]
                         .Rows(2).Resize(n).Value = arO
                         .Borders.Weight = xlThin
                         .Rows(1).Font.Bold = True
                      End With
                   End With
                   
                   Application.ScreenUpdating = True
                   
                End Sub

                Comment


                • #9


                  Thanks. Works fine.

                  Comment

                  Working...
                  X