macro to rearrange data

King Nothing

New Member
Joined
May 1, 2007
Messages
15
Hey all

I need to write a macro which rearranges my data for me. The data looks like this;

Data______________Unit_____Jan06_____Feb06_____Mar06___(etc)
Coal consumption___tonnes
Coal energy________GJ
Electricity__________Mwh
Production_________tonnes
etc

This macro will need to be applied to a number of sheets with different time periods and different types of "Data". What I want to do is write a macro that will transform the data to look like this (where xxx is the data entries);

Coal consumption___xxxx____tonnes___Jan06
Coal consumption___xxxx____tonnes___Feb06
Coal consumption___xxxx____tonnes___Mar06
Coal energy________xxxx______GJ____Jan06
Coal energy________xxxx______GJ____Feb06
Coal energy________xxxx______GJ____Mar06
etc.

So that I can easily import it into access. I know basically how to do it, but I can't automate it to apply to a sheet with any stretch of data fields or types of data. Any help is greatly appreciated! :LOL:
 

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
Back up first and try
Code:
Sub test()
Dim a, i As Long, ii As Integer, b(), n As Long
With Range("a1")
    With .CurrentRegion
        a = .Value
        .ClearContents
    End With
    ReDim b(1 To (UBound(a,1)-1) * (UBound(a,2) - 2), 1 To 4)
    For i = 2 To UBound(a,1)
        For ii = 3 To UBound(a,2)
            n = n + 1
            b(n,1) = a(i,1) : b(n,3) = a(i,2) : b(n,4) = a(1,ii)
        Next
    Next
    .Resize(n,4).Value = b
End With
End Sub
 
Upvote 0
You sir, are a champion! Thanks heaps, exactly what I was looking for.

Edit: Whoops, had a look at it and it actually doesn't capture the data, just has 3 columns of data type, unit and date. None of the actual numbers have been captured.
 
Upvote 0
Looks like one little thing was missed. Try this modified version
Code:
Sub test()
  
  Dim a, i As Long, ii As Integer, b(), n As Long
  
  With Range("a1")
    With .CurrentRegion
      a = .Value
      .ClearContents
    End With
    ReDim b(1 To (UBound(a, 1) - 1) * (UBound(a, 2) - 2), 1 To 4)
    For i = 2 To UBound(a, 1)
      For ii = 3 To UBound(a, 2)
        n = n + 1
        b(n, 1) = a(i, 1): b(n, 2) = a(i, ii): b(n, 3) = a(i, 2): b(n, 4) = a(1, ii)
      Next
    Next
    .Resize(n, 4).Value = b
  End With

End Sub
 
Upvote 0
Looks like one little thing was missed. Try this modified version
I don't think so.
OP is just wanting to create a "Table" to insert the data.

And if that is what you are saying, the code should be like this
Code:
Sub test() 
Dim a, i As Long, ii As Integer, b(), n As Long 
With Range("a1") 
    With .CurrentRegion 
        a = .Value 
        .ClearContents 
    End With 
    ReDim b(1 To (UBound(a,1)-1) * (UBound(a,2) - 2), 1 To 4) 
    For i = 2 To UBound(a,1) 
        For ii = 3 To UBound(a,2) 
            If a(i,ii) <> "" Then
                n = n + 1 
                b(n,1) = a(i,1) : b(n,2) = a(i,ii) : b(n,3) = a(i,2) : b(n,4) = a(1,ii) 
            End If
        Next 
    Next 
    .Resize(n,4).Value = b 
End With 
End Sub
 
Upvote 0
Thanks, Jindon. Spot on.

I thought you'd stopped for the day - long time between posts - so I jumped in.

regards, Fazza
 
Upvote 0
Fazza

No worries, but your assumption seems to be right.
I don't know why these guys(OP) do like this, not asking here, but in the other site on the same issue...
 
Upvote 0
Maybe it was urgent? Even though it was only a few hours. Best regards, Fazza
 
Upvote 0
Right

I just saw
Edit: Whoops, had a look at it and it actually doesn't capture the data, just has 3 columns of data type, unit and date. None of the actual numbers have been captured.
in PO's post, but it is hardly noticed....
 
Upvote 0

Forum statistics

Threads
1,215,832
Messages
6,127,152
Members
449,366
Latest member
reidel

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