Fairly complex VBA Code challenge?

Z

zico2000

New Member
Joined
Feb 23, 2017
Messages
6
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:

[TABLE="width: 384"]
<tbody>[TR]
[TD]Type[/TD]
[TD]Store[/TD]
[TD]Value[/TD]
[TD]France[/TD]
[TD]Germany[/TD]
[/TR]
[TR]
[TD]Colour[/TD]
[TD]UK[/TD]
[TD]Red[/TD]
[TD]Rouge[/TD]
[TD]Rot[/TD]
[/TR]
[TR]
[TD]Shape[/TD]
[TD]UK[/TD]
[TD]Round[/TD]
[TD]Ronde[/TD]
[TD]Rund[/TD]
[/TR]
[TR]
[TD]Colour[/TD]
[TD]UK[/TD]
[TD]Green[/TD]
[TD]Verte[/TD]
[TD]Grun[/TD]
[/TR]
</tbody>[/TABLE]

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

[TABLE="width: 240"]
<tbody>[TR]
[TD]Type[/TD]
[TD]Store[/TD]
[TD]Value[/TD]
[/TR]
[TR]
[TD]Colour[/TD]
[TD]UK[/TD]
[TD]Red[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]FR[/TD]
[TD]Rouge[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]DE[/TD]
[TD]Rot[/TD]
[/TR]
[TR]
[TD]Shape[/TD]
[TD]UK[/TD]
[TD]Round[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]FR[/TD]
[TD]Ronde[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]DE[/TD]
[TD]Rund[/TD]
[/TR]
[TR]
[TD]Colour[/TD]
[TD]UK[/TD]
[TD]Green[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]FR[/TD]
[TD]Verte[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]DE[/TD]
[TD]Grun[/TD]
[/TR]
</tbody>[/TABLE]

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
 
Sort by date Sort by votes
hiker95 said:
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
ABCDEFGHIJ

<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
[TD="align: center"]1[/TD]
[TD="bgcolor: #FFFFFF"]Type[/TD]
[TD="bgcolor: #FFFFFF"]Store[/TD]
[TD="bgcolor: #FFFFFF"]Value[/TD]
[TD="bgcolor: #FFFFFF"]France[/TD]
[TD="bgcolor: #FFFFFF"]Germany[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]2[/TD]
[TD="bgcolor: #FFFFFF"]Colour[/TD]
[TD="bgcolor: #FFFFFF"]UK[/TD]
[TD="bgcolor: #FFFFFF"]Red[/TD]
[TD="bgcolor: #FFFFFF"]Rouge[/TD]
[TD="bgcolor: #FFFFFF"]Rot[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]3[/TD]
[TD="bgcolor: #FFFFFF"]Shape[/TD]
[TD="bgcolor: #FFFFFF"]UK[/TD]
[TD="bgcolor: #FFFFFF"]Round[/TD]
[TD="bgcolor: #FFFFFF"]Ronde[/TD]
[TD="bgcolor: #FFFFFF"]Rund[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]4[/TD]
[TD="bgcolor: #FFFFFF"]Colour[/TD]
[TD="bgcolor: #FFFFFF"]UK[/TD]
[TD="bgcolor: #FFFFFF"]Green[/TD]
[TD="bgcolor: #FFFFFF"]Verte[/TD]
[TD="bgcolor: #FFFFFF"]Grun[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]5[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]6[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]7[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]8[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]9[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]10[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]11[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

</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
ABCDEFGHIJ
TypeStoreValue
ColourUKRed
FRRouge
DERot
ShapeUKRound
FRRonde
DERund
ColourUKGreen
FRVerte
DEGrun

<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
[TD="align: center"]1[/TD]
[TD="bgcolor: #FFFFFF"]Type[/TD]
[TD="bgcolor: #FFFFFF"]Store[/TD]
[TD="bgcolor: #FFFFFF"]Value[/TD]
[TD="bgcolor: #FFFFFF"]France[/TD]
[TD="bgcolor: #FFFFFF"]Germany[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]2[/TD]
[TD="bgcolor: #FFFFFF"]Colour[/TD]
[TD="bgcolor: #FFFFFF"]UK[/TD]
[TD="bgcolor: #FFFFFF"]Red[/TD]
[TD="bgcolor: #FFFFFF"]Rouge[/TD]
[TD="bgcolor: #FFFFFF"]Rot[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]3[/TD]
[TD="bgcolor: #FFFFFF"]Shape[/TD]
[TD="bgcolor: #FFFFFF"]UK[/TD]
[TD="bgcolor: #FFFFFF"]Round[/TD]
[TD="bgcolor: #FFFFFF"]Ronde[/TD]
[TD="bgcolor: #FFFFFF"]Rund[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]4[/TD]
[TD="bgcolor: #FFFFFF"]Colour[/TD]
[TD="bgcolor: #FFFFFF"]UK[/TD]
[TD="bgcolor: #FFFFFF"]Green[/TD]
[TD="bgcolor: #FFFFFF"]Verte[/TD]
[TD="bgcolor: #FFFFFF"]Grun[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]5[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]6[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]7[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]8[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]9[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]10[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]11[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

</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).

Code: 
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.
Click to expand...

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.
 
Upvote 0
Brilliant thank you.

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

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.
Click to expand...

When the time comes, we would probably have to see your actual raw data workbook.
 
Upvote 0
You must log in or register to reply here.

Similar threads

U
  • Question Question
Excel Activate workbook1/sheet, Copy/paste row in workbook2/sheet, activate autofilter, return value and loop
Replies
0
Views
212
user29383902
U
S
  • Solved
Sort multiple columns on sheet into A-Z
Replies
2
Views
392
surkdidat
S
R
  • Solved
VBA Code for pasting Value every nth cell in 2 different rows
Replies
8
Views
464
Reefbreaker
R
S
  • Question Question
VBA Code- finding #Spill and moving the formula to the next column
Replies
0
Views
882
stromnoexcel
S
K
  • Question Question
VBA for using a check box to Regen that row and then uncheck the box (ready to run macro again)
Replies
1
Views
739
Micron
M

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top