transpose macro

[nip2511]

i have 1000 tables in one sheet the tables have same amount of data ie each table have 6 column and 48 rows each table is below other table.
I want to transpose all tables through macro and result in same sheet or next sheet.

[GTO]

Greetings nip2511,

I see that you just joined and this is your first post. Welcome to vbaexpress!:hi:

Please attach your workbook or a sample workbook that accurately portrays your current workbook on one sheet, and what it should look like 'After' on another sheet. This makes it much easier to see exactly what you want to do, as well as shows us whether there is a consistent number of rows between tables and such.

Mark

[nip2511]

I am sending file which contain 2 sheets one is orignal contains data which i have and second sheet result which contain result which i desire from macro

[GTO]

Hi again,

Adjust as desired. I did not add so many rows between, as it seemed you may have layed out the example for being easy to read, more than what would seem desired?

In a Standard Module:


Option Explicit

Sub TransposeRecords()
Dim _
wksOutput As Worksheet, _
aryInput As Variant, _
aryOutput As Variant, _
lRowCount As Long, _
lRecordCount As Long, _
lRecord As Long, _
lCurTopRow As Long, _
lURowOut As Long, _
lOffset As Long

Const START_AT_ROW As Long = 1

With ThisWorkbook

'// Change to suite or use sheet's codename //
With .Worksheets("orignal")

'// Add a sheet for output. //
Set wksOutput = .Parent.Worksheets.Add(After:=.Parent.Worksheets(.Name))

'// Grab all the source data. //
aryInput = .Range(.Cells(START_AT_ROW, 1), _
.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 6) _
).Value

'// Get total rows of source data. //
lRowCount = .Cells(.Rows.Count, "A").End(xlUp).Row - START_AT_ROW + 1
'// See how many recordsets there are //
lRecordCount = lRowCount \ 38

'// Size out output array. //
ReDim aryOutput(1 To (7 * lRecordCount), 1 To 38)

'// We will be looping thru chunks of both in/out arrays; set initial //
'// positions //
lCurTopRow = 0
lURowOut = 1

'// Loop thru recordsets //
For lRecord = 1 To lRecordCount

'// Set top row of current chunk of input array //
lCurTopRow = (lRecord * 38) - 37

'// output chunk category like "Quarterly Results of GTL" and //
'// whatever this is called: "------------------- in Rs. Cr. -------------------//
aryOutput(lURowOut, 1) = aryInput(lCurTopRow, 1)
aryOutput(lURowOut + 1, 1) = aryInput(lCurTopRow, 2)

'// "Dates". These are actually strings, you may need to coerce if //
'// they are to be calculated against later. Not sure why you wanyted //
'// to skip over so many columns, but as shown in example supplied. //
aryOutput(lURowOut + 1, 6) = aryInput(lCurTopRow + 5, 2)
aryOutput(lURowOut + 2, 6) = aryInput(lCurTopRow + 5, 3)
aryOutput(lURowOut + 3, 6) = aryInput(lCurTopRow + 5, 4)
aryOutput(lURowOut + 4, 6) = aryInput(lCurTopRow + 5, 5)
aryOutput(lURowOut + 5, 6) = aryInput(lCurTopRow + 5, 6)

'// Sub categories like "Sales Turnover" etc //
aryOutput(lURowOut, 8) = aryInput(lCurTopRow + 7, 1)
aryOutput(lURowOut, 9) = aryInput(lCurTopRow + 8, 1)
aryOutput(lURowOut, 10) = aryInput(lCurTopRow + 9, 1)
aryOutput(lURowOut, 11) = aryInput(lCurTopRow + 10, 1)
aryOutput(lURowOut, 12) = aryInput(lCurTopRow + 11, 1)
aryOutput(lURowOut, 13) = aryInput(lCurTopRow + 12, 1)
aryOutput(lURowOut, 14) = aryInput(lCurTopRow + 13, 1)
aryOutput(lURowOut, 15) = aryInput(lCurTopRow + 14, 1)
aryOutput(lURowOut, 16) = aryInput(lCurTopRow + 15, 1)
aryOutput(lURowOut, 17) = aryInput(lCurTopRow + 16, 1)
aryOutput(lURowOut, 18) = aryInput(lCurTopRow + 17, 1)
aryOutput(lURowOut, 19) = aryInput(lCurTopRow + 18, 1)
aryOutput(lURowOut, 20) = aryInput(lCurTopRow + 19, 1)
aryOutput(lURowOut, 21) = aryInput(lCurTopRow + 20, 1)
aryOutput(lURowOut, 22) = aryInput(lCurTopRow + 21, 1)
aryOutput(lURowOut, 23) = aryInput(lCurTopRow + 22, 1)
aryOutput(lURowOut, 24) = aryInput(lCurTopRow + 23, 1)
aryOutput(lURowOut, 25) = aryInput(lCurTopRow + 24, 1)
aryOutput(lURowOut, 26) = aryInput(lCurTopRow + 25, 1)
aryOutput(lURowOut, 27) = aryInput(lCurTopRow + 26, 1)
aryOutput(lURowOut, 28) = aryInput(lCurTopRow + 27, 1)
aryOutput(lURowOut, 29) = aryInput(lCurTopRow + 28, 1)
aryOutput(lURowOut, 30) = aryInput(lCurTopRow + 29, 1)
aryOutput(lURowOut, 31) = aryInput(lCurTopRow + 30, 1)
aryOutput(lURowOut, 32) = aryInput(lCurTopRow + 31, 1)
aryOutput(lURowOut, 33) = aryInput(lCurTopRow + 32, 1)
aryOutput(lURowOut, 34) = aryInput(lCurTopRow + 33, 1)
aryOutput(lURowOut, 35) = aryInput(lCurTopRow + 34, 1)
aryOutput(lURowOut, 36) = aryInput(lCurTopRow + 35, 1)
aryOutput(lURowOut, 37) = aryInput(lCurTopRow + 36, 1)
aryOutput(lURowOut, 38) = aryInput(lCurTopRow + 37, 1)

'// Loop thru vals, transposing along the way. I would note that whatever//
'// your source is, you are getting double unaries as zeros and that this//
'// looks like the start of a formula to Excel. May want to clean up on//
'// way in, or change numberformat of dest cells to text? //
For lOffset = 1 To 5
aryOutput(lURowOut + lOffset, 8) = aryInput(lCurTopRow + 7, 1 + lOffset)
aryOutput(lURowOut + lOffset, 9) = aryInput(lCurTopRow + 8, 1 + lOffset)
aryOutput(lURowOut + lOffset, 10) = aryInput(lCurTopRow + 9, 1 + lOffset)
aryOutput(lURowOut + lOffset, 11) = aryInput(lCurTopRow + 10, 1 + lOffset)
aryOutput(lURowOut + lOffset, 12) = aryInput(lCurTopRow + 11, 1 + lOffset)
aryOutput(lURowOut + lOffset, 13) = aryInput(lCurTopRow + 12, 1 + lOffset)
aryOutput(lURowOut + lOffset, 14) = aryInput(lCurTopRow + 13, 1 + lOffset)
aryOutput(lURowOut + lOffset, 15) = aryInput(lCurTopRow + 14, 1 + lOffset)
aryOutput(lURowOut + lOffset, 16) = aryInput(lCurTopRow + 15, 1 + lOffset)
aryOutput(lURowOut + lOffset, 17) = aryInput(lCurTopRow + 16, 1 + lOffset)
aryOutput(lURowOut + lOffset, 18) = aryInput(lCurTopRow + 17, 1 + lOffset)
aryOutput(lURowOut + lOffset, 19) = aryInput(lCurTopRow + 18, 1 + lOffset)
aryOutput(lURowOut + lOffset, 20) = aryInput(lCurTopRow + 19, 1 + lOffset)
aryOutput(lURowOut + lOffset, 21) = aryInput(lCurTopRow + 20, 1 + lOffset)
aryOutput(lURowOut + lOffset, 22) = aryInput(lCurTopRow + 21, 1 + lOffset)
aryOutput(lURowOut + lOffset, 23) = aryInput(lCurTopRow + 22, 1 + lOffset)
aryOutput(lURowOut + lOffset, 24) = aryInput(lCurTopRow + 23, 1 + lOffset)
aryOutput(lURowOut + lOffset, 25) = aryInput(lCurTopRow + 24, 1 + lOffset)
aryOutput(lURowOut + lOffset, 26) = aryInput(lCurTopRow + 25, 1 + lOffset)
aryOutput(lURowOut + lOffset, 27) = aryInput(lCurTopRow + 26, 1 + lOffset)
aryOutput(lURowOut + lOffset, 28) = aryInput(lCurTopRow + 27, 1 + lOffset)
aryOutput(lURowOut + lOffset, 29) = aryInput(lCurTopRow + 28, 1 + lOffset)
aryOutput(lURowOut + lOffset, 30) = aryInput(lCurTopRow + 29, 1 + lOffset)
aryOutput(lURowOut + lOffset, 31) = aryInput(lCurTopRow + 30, 1 + lOffset)
aryOutput(lURowOut + lOffset, 32) = aryInput(lCurTopRow + 31, 1 + lOffset)
aryOutput(lURowOut + lOffset, 33) = aryInput(lCurTopRow + 32, 1 + lOffset)
aryOutput(lURowOut + lOffset, 34) = aryInput(lCurTopRow + 33, 1 + lOffset)
aryOutput(lURowOut + lOffset, 35) = aryInput(lCurTopRow + 34, 1 + lOffset)
aryOutput(lURowOut + lOffset, 36) = aryInput(lCurTopRow + 35, 1 + lOffset)
aryOutput(lURowOut + lOffset, 37) = aryInput(lCurTopRow + 36, 1 + lOffset)
aryOutput(lURowOut + lOffset, 38) = aryInput(lCurTopRow + 37, 1 + lOffset)
Next

'// adjust to next chunk in output array //
lURowOut = lURowOut + 7
Next
End With
End With

'// Size an output Range to match the output array size, plunk in the array, fit //
'// columns. //
With wksOutput.Range("A1").Resize(UBound(aryOutput, 1), UBound(aryOutput, 2))
.Value = aryOutput
.EntireColumn.AutoFit
End With
End Sub

Hope that helps,

Mark

[nip2511]

Great.... Simply Great, and thank you for the support and time given to me though i am new here.
thank you again

[GTO]

You are most welcome and glad it worked. :beerchug: