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.

A	B	C	D	E	F
Product	Quantity	Price	Client 1	Client 2	Client 3
Bread	10	$1.00	4	3	3
Milk	12	$0.80	8	0	4

<tbody>
</tbody>

H	I	J	K
Product	Quantity	Price	Client
Bread	4	1.00	Client 1
Bread	3	1.00	Client 2
Bread	3	1.00	Client 3
Milk	8	0.80	Client 1
Milk	4	0.80	Client 3

<tbody>
</tbody>

 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