Please I Need Help In Modifying Some Code

[woodpecker2]

I currently have data in the format of a table with row one as Origin and the first column as Destination, the data inbetween are the volumes.

Using some code I previously found I can take the data from the table and create a list. Basically it takes the Destinatin and Origin and where they intersect the value.

This is the code I'm currently using:-

Private Sub CommandButton1_Click()
Dim a, b(), i As Long
a = Sheets("sheet1").Range("a1").CurrentRegion.Value
ReDim b(1 To (UBound(a, 1) - 1) * (UBound(a, 2) - 1), 1 To 3)
For i = 2 To UBound(a, 2)
    For ii = 2 To UBound(a, 1)
        n = n + 1
        b(n, 1) = a(ii, 1): b(n, 2) = a(1, i)
        b(n, 3) = a(ii, i)
        If IsEmpty(a(ii, i)) Then b(n, 3) = 0
    Next
Next
With Sheets("sheet2").Range("a1")
    .Cells.Clear
    .Resize(, 3) = Array("Destination", "Origin", "Amount")
    .Offset(1).Resize(UBound(b, 1), 3) = b
End With
Erase a, b
End Sub

This where I now need some help. I need to add an additional column so that not only does it pick up row one and column A, I also need column B to be shown as well.

Current Data Table:

TestThree.xls
	A	B	C	D	E	F	G	H	I
1	Costings	A	B	C	D	E	F	G	H
2	AA	9.28	0.03	0.00	0.28	0.00	0.13	0.04	0.07
3	BB	0.16	3.62	0.00	0.36	0.00	0.61	1.09	0.05
4	CC	0.04	0.04	0.00	0.27	0.00	0.85	0.03	0.04
5	DD	0.23	0.12	0.00	0.35	0.00	0.24	0.24	0.09
Sheet1

Current Result

TestThree.xls
	A	B	C	D
1	Destination	Origin	Amount
2	AA	A	9.28
3	BB	A	0.16
4	CC	A	0.04
5	DD	A	0.23
6	AA	B	0.03
7	BB	B	3.62
8	CC	B	0.04
9	DD	B	0.12
10	AA	C	0.00
11	BB	C	0.00
12	CC	C	0.00
13	DD	C	0.00
14	AA	D	0.28
15	BB	D	0.36
16	CC	D	0.27
17	DD	D	0.35
Sheet2

I'll show what I'm after in a minute.

 

[woodpecker2]

This is what the new table will be like:-

TestThree.xls
	A	B	C	D	E	F	G	H	I	J
1	Costings		A	B	C	D	E	F	G	H
2	AA	Mon	9.28	0.03	0.00	0.28	0.00	0.13	0.04	0.07
3	BB	Tue	0.16	3.62	0.00	0.36	0.00	0.61	1.09	0.05
4	CC	Wed	0.04	0.04	0.00	0.27	0.00	0.85	0.03	0.04
5	DD	Thu	0.23	0.12	0.00	0.35	0.00	0.24	0.24	0.09
Sheet1

This is the result I'm after:-

TestThree.xls
	A	B	C	D
1	Destination	Origin	Amount	Filter
2	AA	A	9.28	Mon
3	BB	A	0.16	Tue
4	CC	A	0.04	Wed
5	DD	A	0.23	Thu
6	AA	B	0.03	Mon
7	BB	B	3.62	Tue
8	CC	B	0.04	Wed
9	DD	B	0.12	Thu
10	AA	C	0.00	Mon
11	BB	C	0.00	Tue
12	CC	C	0.00	Wed
13	DD	C	0.00	Thu
14	AA	D	0.28	Mon
15	BB	D	0.36	Tue
16	CC	D	0.27	Wed
17	DD	D	0.35	Thu
Sheet2

Please note the actual table I will be using is much greater and this is only a small sample.

 

[Legacy 14611]

Try this:

Private Sub CommandButton1_Clickx()
Dim a, b(), i As Long
a = Sheets("sheet1").Range("a1").CurrentRegion.Value
ReDim b(1 To (UBound(a, 1) - 1) * (UBound(a, 2) - 1), 1 To 4)
For i = 3 To UBound(a, 2)
    For ii = 2 To UBound(a, 1)
        n = n + 1
        b(n, 1) = a(ii, 1): b(n, 2) = a(1, i)
        b(n, 3) = a(ii, i): b(n, 4) = a(ii, 2)
        If IsEmpty(a(ii, i)) Then b(n, 3) = 0
    Next
Next
With Sheets("sheet2").Range("a1")
    .Cells.Clear
    .Resize(, 4) = Array("Destination", "Origin", "Amount", "Filter")
    .Offset(1).Resize(UBound(b, 1), 4) = b
End With
Erase a, b
End Sub

 

[woodpecker2]

Thanks that works fine.

I'm trying to understand the code but am having trouble fathoming it out.

If I wanted to swap column A and B around, which part of the code would need amending as I wish to see the same results?

 

[Legacy 14611]

Thanks that works fine.

I'm trying to understand the code but am having trouble fathoming it out.

If I wanted to swap column A and B around, which part of the code would need amending as I wish to see the same results?

It wasn't my code. Looks like one of Jindon's.

However, try this:

Private Sub CommandButton1_Clickxx()
Dim a, b(), i As Long
a = Sheets("sheet1").Range("a1").CurrentRegion.Value
ReDim b(1 To (UBound(a, 1) - 1) * (UBound(a, 2) - 1), 1 To 4)
For i = 3 To UBound(a, 2)
    For ii = 2 To UBound(a, 1)
        n = n + 1
        b(n, 1) = a(ii, 2): b(n, 2) = a(1, i)
        b(n, 3) = a(ii, i): b(n, 4) = a(ii, 1)
        If IsEmpty(a(ii, i)) Then b(n, 3) = 0
    Next
Next
With Sheets("sheet2").Range("a1")
    .Cells.Clear
    .Resize(, 4) = Array("Destination", "Origin", "Amount", "Filter")
    .Offset(1).Resize(UBound(b, 1), 4) = b
End With
Erase a, b
End Sub