Loop through multiple columns and transposing data

[mozza90]

Hi there,

I have some data which is in the below format. I'd like to manipulate this so it looks like the second table. However I'm having some trouble with my loop where I can only run it for client 1, and can't figure out how to add client 2 and 3 to the column K with the respective quantities, price and product.

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[TD="align: center"]D[/TD]
[TD="align: center"]E[/TD]
[TD="align: center"]F[/TD]
[/TR]
[TR]
[TD="align: center"]Product[/TD]
[TD="align: center"]Quantity[/TD]
[TD="align: center"]Price[/TD]
[TD="align: center"]Client 1[/TD]
[TD="align: center"]Client 2[/TD]
[TD="align: center"]Client 3[/TD]
[/TR]
[TR]
[TD="align: center"]Bread[/TD]
[TD="align: center"]10[/TD]
[TD="align: center"]$1.00[/TD]
[TD="align: center"]4[/TD]
[TD="align: center"]3[/TD]
[TD="align: center"]3[/TD]
[/TR]
[TR]
[TD="align: center"]Milk[/TD]
[TD="align: center"]12[/TD]
[TD="align: center"]$0.80[/TD]
[TD="align: center"]8[/TD]
[TD="align: center"]0[/TD]
[TD="align: center"]4[/TD]
[/TR]
</tbody>[/TABLE]

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]H[/TD]
[TD]I[/TD]
[TD]J[/TD]
[TD]K[/TD]
[/TR]
[TR]
[TD]Product[/TD]
[TD]Quantity[/TD]
[TD]Price[/TD]
[TD]Client[/TD]
[/TR]
[TR]
[TD]Bread[/TD]
[TD]4[/TD]
[TD]1.00[/TD]
[TD]Client 1[/TD]
[/TR]
[TR]
[TD]Bread[/TD]
[TD]3[/TD]
[TD]1.00[/TD]
[TD]Client 2[/TD]
[/TR]
[TR]
[TD]Bread[/TD]
[TD]3[/TD]
[TD]1.00[/TD]
[TD]Client 3[/TD]
[/TR]
[TR]
[TD]Milk[/TD]
[TD]8[/TD]
[TD]0.80[/TD]
[TD]Client 1[/TD]
[/TR]
[TR]
[TD]Milk[/TD]
[TD]4[/TD]
[TD]0.80[/TD]
[TD]Client 3[/TD]
[/TR]
</tbody>[/TABLE]

 Dim row As Integer


     row = 2

Do While .Range("A" & row) <> ""
            If .Range("B" & row) > 0 Then
               .Range("H" & row) = Range("A" & row)
               .Range("I" & row) = Range("B" & row)
               .Range("J" & row) = Range("C" & row)
               .Range("D" & row) = Range("K" & row)


'doesn't continue to add these clients

               .Range("E" & row) = Range("K" & row)
               .Range("F" & row) = Range("K" & row)
             
'etc....




              End If
                 
                 
                 row = row + 1
         Loop

Any ideas of where I'm going wrong?

Ta!

 

[Fluff]

How about

Sub TransposeData()
   Dim ary As Variant, Nary() As Variant
   Dim r As Long, c As Long, j As Long
   ary = Range("A1").CurrentRegion.Value2
   ReDim Nary(1 To UBound(ary) * 3, 1 To 4)
   j = j + 1
   For c = 1 To 3
      Nary(1, c) = ary(1, c)
   Next c
   Nary(1, 4) = "Client"
   For r = 2 To UBound(ary)
      For c = 4 To UBound(ary, 2)
         If ary(r, c) <> 0 Then
            j = j + 1
            Nary(j, 1) = ary(r, 1)
            Nary(j, 2) = ary(r, c)
            Nary(j, 3) = ary(r, 3)
            Nary(j, 4) = ary(1, c)
         End If
      Next c
   Next r
   Range("H1").Resize(j, 4).Value = Nary
End Sub

 

[mozza90]

That's perfect. thank you!

 

[Fluff]

Glad to help & thanks for the feedback