Transposing data using VBA

[Mr2017]

Hi

I have some data in a Summary sheet which starts in column J and goes up to column AY in a Sheet.

Below is a small sample - just 9 columns and three rows.

The data is in blocks of three different columns ("Location & Dist", "Platform", and "Percentage") - please ignore the numbers, as this is random data. Is there a better way to transpose this data into one column? At present, the code I have only copies specific columns, but the number of columns could change in a future file. So I was wondering how to take that into account? ie is there a way of getting the code to continue copying three blocks of data until it reaches a blank column?

Location & Dist	Platform: C	Percentage	Location & Dist	Platform: PM	Percentage	Location & Dist	Platform: S	Percentage
Address 1Plt: C	$20,591.00​	0%	Address 1Plt: PM	$29,787.00​	0%	Address 1Plt: S	$72,763.00​	0%
Address 2Plt: C	$23,003.00​	0%	Address 2Plt: PM	$92,523.00​	0%	Address 2Plt: S	$71,299.00​	0%
Address 3Plt: C	$82,273.00​	0%	Address 3Plt: PM	$14,975.00​	0%	Address 3Plt: S	$87,301.00​	0%

​

​

​

My current process is this:

Go to Sheet 24 (the Summary sheet) copy the block of data in columns J to L, then go to cell A1 in Sheet 1 and paste it. It then covers columns A-C in Sheet 1.

Go back to Sheet 24 (the Summary sheet), copy the next block of data in columns M to O, then go to the bottom of the range of data pasted in Sheet 1 and paste the newly acquired data there.



I'd be grateful for any thoughts? My code is below - I've left in the code that copies columns beyond the number shown above, as the actual file has more columns. But I'd like the code to stop, if I only have 9 columns, or keep on going, if I have more. Please let me know if you want me to clarify anthing. Thanks in advance

Sub GetPercentageData()

'Sheet24 in the code below is the Summary Sheet
'Sheet 1 is the transposing sheet, where I am pasting data that's in multiple columns in Sheet 24 (the Summary Sheet)
'into one column in the transposing sheet.

'first clear the sheet with the existing percentage data

Sheet1.Activate

Range("A1").CurrentRegion.Select

Selection.ClearContents
Selection.ClearFormats

'then go to the Summary sheet with the percentage data

Sheet24.Activate

'copy the data from the first group in columns J:L.

Range("J15", Range("L15").End(xlDown)).Copy

'paste their unique ID codes and percentage data into your 'transposing' sheet

Sheet1.Activate

Range("A1").PasteSpecial xlPasteValues

'go back to the Summary Sheet (Sheet24) and get the next set of percentage data

Sheet24.Activate

Range("M15", Range("O15").End(xlDown)).Copy

'go to the transposing sheet

Sheet1.Activate
'go to the bottom of the range in Sheet 1 and paste in the newly acquired data

Range("A1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues

'back to the Summary sheet

Sheet24.Activate

Range("P15", Range("R15").End(xlDown)).Copy

'transposing sheet

Sheet1.Activate
'go to the bottom of the range in Sheet 1 and paste in the newly acquired data

Range("A1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues


End Sub

 

[offthelip]

try this code:

Sub test()
Dim outarr()
With Worksheets("Sheet24")
lastrow = .Range("A1").SpecialCells(xlCellTypeLastCell).Row
lastcolumn = .Range("A1").SpecialCells(xlCellTypeLastCell).Column
 inarr = .Range(.Cells(1, 1), .Cells(lastrow, lastcolumn))
End With
With Worksheets("Sheet1")
lastout = (1 + Round((lastcolumn / 3))) * lastrow
ReDim outarr(1 To lastout, 1 To 3)
indi = 1
For i = 10 To UBound(inarr, 2) Step 3
   For j = 1 To UBound(inarr, 1)
    For k = 0 To 2
       outarr(indi, k + 1) = inarr(j, i + k)
    Next k
    indi = indi + 1
   Next j
Next i
 Range(.Cells(1, 1), .Cells(indi, 3)) = outarr
 
End With
End Sub

 

[Mr2017]

Hi @offtheflip

Thanks for the prompt response!

I tried to run the code, but it gave me a "run time error: 9 (subscript out of range)" message when it got to this line:

outarr(indi, k + 1) = inarr(j, i + k)

Do you know why that may be?

Thanks in advance.

 

[offthelip]

try changning this line:

For i = 10 To UBound(inarr, 2) Step 3

to

For i = 10 To UBound(inarr, 2)-3 Step 3

 

[Mr2017]

Thanks.

That made it run successfully.

However, some columns of data weren't together correctly, at the end?

Eg these columns were grouped together.

But they should have had a "Location & Dist." column, as well as a "Package" column, in between them

Plt: SBB	Plt: Eclipse	Plt: PIRA Dimensions
0.000302​	0​	0​
0​	0​	0.000238​
0​	0​	0​
0.08406​	0​	0.087886​
0.001913​	0​	0​
0​	0​	0.000238​

 

[offthelip]

the code works by grabbing 3 columns and pasting them below the last paste, it doesn't concern it self with the contents. it reliably grabs 3 columns so if the result is not what you want it is because the data doesn't quite match what you are expecting. Can you paste the header row of the data you are using to forum??

 

[Mr2017]

Aha! You were right! Apologies!

There were some additional columns at the end of the file that I hadn't noticed before.

I thought that the code would stop when it got to a a blank column. But it carried on. If you know of a way to make it stop when it reaches a blank column, please let me know.

If not, don't worry.

Thanks for your help with this!

 

[offthelip]

You could try adding this line after the i loop control:

For i = 10 To UBound(inarr, 2)-3 Step 3
if inarr(1,i)="" then Exit for

thatwill catch a blank line in Loc & Dist column , but doesn't detect it in the others. see if that if good enough

 

[Mr2017]

Ok, thanks - I'll try that tomorrow. Just in the middle of debugging some other code!