Fairly complex VBA Code challenge?

[zico2000]

Hey guys,

I normally would find my own answers by searching the forums and looking at similar questions in the past. However this is a tricky one and I do not really know where to start. I would dearly appreciate any help with my query? ....

I have a spreadsheet, simplified for purposes of demonstrating the problem:

Type	Store	Value	France	Germany
Colour	UK	Red	Rouge	Rot
Shape	UK	Round	Ronde	Rund
Colour	UK	Green	Verte	Grun

<tbody>
</tbody>

I am trying to write some VBA code into a Macro that I can run to produce this outcome:

Type	Store	Value
Colour	UK	Red
	FR	Rouge
	DE	Rot
Shape	UK	Round
	FR	Ronde
	DE	Rund
Colour	UK	Green
	FR	Verte
	DE	Grun

<tbody>
</tbody>

So basically it loops through each row, inserts two rows underneath and then copies France into the first added row and Germany into the second.

I hope that makes sense and I am more than happy to provide any further clarification. Many thanks in advance.

Yours hopefully,
Paul

 

[zico2000]

zico2000,

Here is another macro for you to consider, that is based on your flat text displays, that uses two arrays in memory, and, should be fast.

Sample raw data in the active worksheet:

Excel 2007

	A	B	C	D	E	F	G	H	I	J
1	Type	Store	Value	France	Germany
2	Colour	UK	Red	Rouge	Rot
3	Shape	UK	Round	Ronde	Rund
4	Colour	UK	Green	Verte	Grun
5
6
7
8
9
10
11

<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>

Sheet1​

And, after the macro in the same worksheet, beginning in the third column to the right of the last used column of the raw data:

Excel 2007

	A	B	C	D	E	F	G	H	I	J
1	Type	Store	Value	France	Germany			Type	Store	Value
2	Colour	UK	Red	Rouge	Rot			Colour	UK	Red
3	Shape	UK	Round	Ronde	Rund				FR	Rouge
4	Colour	UK	Green	Verte	Grun				DE	Rot
5								Shape	UK	Round
6									FR	Ronde
7									DE	Rund
8								Colour	UK	Green
9									FR	Verte
10									DE	Grun
11

<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>

Sheet1​

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Sub RearrangeData()
' hiker95, 02/23/2017, ME992758
Dim a As Variant, i As Long, c As Long
Dim o As Variant, j As Long
With ActiveSheet
  a = .Cells(1, 1).CurrentRegion
  ReDim o(1 To (UBound(a, 1) - 1) * (UBound(a, 2) - 2), 1 To 3)
  For i = 2 To UBound(a, 1)
    For c = 3 To UBound(a, 2)
      If c = 3 Then
        j = j + 1: o(j, 1) = a(i, 1): o(j, 2) = a(i, 2)
        o(j, 3) = a(i, c)
      ElseIf a(1, c) = "France" Then
        j = j + 1: o(j, 2) = "FR": o(j, 3) = a(i, c)
      ElseIf a(1, c) = "Germany" Then
        j = j + 1: o(j, 2) = "DE": o(j, 3) = a(i, c)
      End If
    Next c
  Next i
  .Columns(UBound(a, 2) + 3).Resize(, 3).ClearContents
  With .Cells(1, UBound(a, 2) + 3).Resize(, 3)
    .Value = Array("Type", "Store", "Value")
    .Font.Bold = True
  End With
  .Cells(2, UBound(a, 2) + 3).Resize(UBound(o, 1), UBound(o, 2)) = o
  .Columns(UBound(a, 2) + 3).Resize(, 3).AutoFit
End With
End Sub

Then run the RearrangeData macro.

Brilliant thank you.

I now have two great viable options to test and compare for speed. Ultimately this will be working on 1000s of rows with a lot more columns than my simple example spreadsheet.

 

[hiker95]

Brilliant thank you.

I now have two great viable options to test and compare for speed.

zico2000,

Thanks for the feedback.

You are very welcome. Glad we could help.

Ultimately this will be working on 1000s of rows with a lot more columns than my simple example spreadsheet.

When the time comes, we would probably have to see your actual raw data workbook.