Transposing Certain Range of Columns Data

[madhuchelliah]

Hello Folks, i want to transpose the data (Data is a string) with header in a range of column. See the example below for better understanding. Top table is the source data and bottom table is expected output. I have data from column A to AJ. 1st row is header. Each row carries data applicable to the respective headers in the column A to AJ. All the cells(F:AJ) will not carry data. I want to copy available data of each row from column F to AJ along with the header and should be inserted verticaly in F column of same row. So the next row has to move down based on the number of inserted columns data. Only copy the column header with has data and to its corresponding row.Number of rows is dynamic. i have no clue how to do VBA. Please give me a solution. Thank you. Stay home stay safe.

A	B	C	D	E	F	AA	AC	AD	AJ
Name	Reg number	School name	Advisor	Email	XXXXX	YYYYY	ZZZZZ	AAAAA	BBBBB
Anto	22222	xx school	john	sds@	@@@@		!!!!		####
cath	33333	yy school	jojn	fsfsfd@		*****	!!!!!	$$$$$	&&&&

A	B	C	D	E	F	G
name	reg number	school name	advisor	email
anto	22222	xx school	john	sds@	XXXXX	@@@@
					ZZZZZ	!!!!
					BBBBB	####
cath	33333	yy school	john	fsfsfd@	YYYYY	*****
					ZZZZZ	!!!!!
					AAAAA	$$$$$
					BBBBB	&&&&

 

[GraH]

madhuchelliah,

Can you share which version of Excel you are using and would you be open to the suggestion of using Power Query?
It would be as simple as:

1. Load range in PQ
2. selecting the columns A-E
3. right click and select Unpivot Other Columns
4. Save and load to Excel

Possible with Excel 2010 or higher on Windows.

 

[madhuchelliah]

Hello GraH, it is working good. Thanks for your efforts. I am running some batch of VBA. So for continuity of my process i prefer doing in VBA. But great solution, a new learning for me. Thank you.

 

[GraH]

That's great, continue the discovery! Sorry, can't be of assistance for VBA.
Stay safe, madhuchelliah.

 

[Fluff]

How about

Sub madhuchelliah()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long, nc As Long
   
   Ary = Sheets("Sheet1").Range("A1").CurrentRegion.Value2
   ReDim Nary(1 To UBound(Ary) * (UBound(Ary, 2) - 5), 1 To 7)
   
   For r = 2 To UBound(Ary)
      For c = 6 To UBound(Ary, 2)
         If Ary(r, c) <> "" Then
            nr = nr + 1
            For nc = 1 To 5
               Nary(nr, nc) = Ary(r, nc)
            Next nc
            Nary(nr, 6) = Ary(1, c)
            Nary(nr, 7) = Ary(r, c)
         End If
      Next c
   Next r
   Sheets("Sheet2").Range("A2").Resize(nr, 7).Value = Nary
End Sub

 

[madhuchelliah]

How about

Sub madhuchelliah()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long, nc As Long
  
   Ary = Sheets("Sheet1").Range("A1").CurrentRegion.Value2
   ReDim Nary(1 To UBound(Ary) * (UBound(Ary, 2) - 5), 1 To 7)
  
   For r = 2 To UBound(Ary)
      For c = 6 To UBound(Ary, 2)
         If Ary(r, c) <> "" Then
            nr = nr + 1
            For nc = 1 To 5
               Nary(nr, nc) = Ary(r, nc)
            Next nc
            Nary(nr, 6) = Ary(1, c)
            Nary(nr, 7) = Ary(r, c)
         End If
      Next c
   Next r
   Sheets("Sheet2").Range("A2").Resize(nr, 7).Value = Nary
End Sub

Hello Fluff, it is working great. But if data is empty from F to AJ, A to E is not displaying in the row. It should be there with empty cells in G and H column. Hope you understood. Thank you. Have a great day. Stay home Stay safe.

 

[Fluff]

How about

Sub madhuchelliah()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long, nc As Long
   
   Ary = Sheets("Sheet1").Range("A1").CurrentRegion.Value2
   ReDim Nary(1 To UBound(Ary) * (UBound(Ary, 2) - 5), 1 To 7)
   
   For r = 2 To UBound(Ary)
      nr = nr + 1
      For nc = 1 To 5
         Nary(nr, nc) = Ary(r, nc)
      Next nc
      For c = 6 To UBound(Ary, 2)
         If Ary(r, c) <> "" Then
            If Nary(nr, 6) = "" Then
               Nary(nr, 6) = Ary(1, c)
               Nary(nr, 7) = Ary(r, c)
            Else
               nr = nr + 1
               For nc = 1 To 5
                  Nary(nr, nc) = Ary(r, nc)
               Next nc
               Nary(nr, 6) = Ary(1, c)
               Nary(nr, 7) = Ary(r, c)
            End If
         End If
      Next c
   Next r
   Sheets("Sheet2").Range("A2").Resize(nr, 7).Value = Nary
End Sub