Thread: Array + Transpose + Table Thanks: 0 Likes:  1 Post #5346155 (1)

1. Array + Transpose + Table

Excel Champs,

Looking for creative solves for the below problem. I have a project sheet that looks something likes below in a table. I need a button function that can transfer in a separate sheet all the values in that row for that project transposed in a column.

Master file (Sheet 1)
 A B C D E 1 Project Owner Status Risk Team 2 A Jack On Track None None 3 B Mary RIsk Short on funding Joe, Mary, Mira 4 C Vick Need Help Need more resources Kayle, Mike

Sheet 2:

 A B 1 Project Name Button/Function (Create Summary)

Example: If Project is selected in sheet 2 cell A1, the outcome below should be in a separate sheet:

 Project Project A Owner Jack Status On Track Risk None Team None

Any help on this, would greatly appreciate it.
Thank you.
****** id="cke_pastebin" style="position: absolute; top: 0px; width: 1px; height: 1px; overflow: hidden; left: -1000px;">
 A B 1 Project Name Button/Function (Create Summary)  Reply With Quote

2. Re: Array + Transpose + Table

Here's a formula version if suits, You could data validate the project names in A1 Sheet 2.

ABCDE
1ProjectOwnerStatusRiskTeam
2AJackOn TrackNoneNone
3BMaryRIskShort on fundingJoe, Mary, Mira
4CVickNeed HelpNeed more resourcesKayle, Mike

Sheet1

AB
1A
2OwnerJack
3StatusOn Track
4RiskNone
5TeamNone

Sheet2

Worksheet Formulas
CellFormula
B2=INDEX(Sheet1!\$B\$2:\$E\$4,MATCH(\$A\$1,Sheet1!\$A\$2:\$A\$4,0),MATCH(\$A2,Sheet1!\$B\$1:\$E\$1,0))  Reply With Quote

3. Re: Array + Transpose + Table

You can use this code in a button (In case you need VBA):

Code:
Sub Create_Summary()

Dim arr As Variant
Dim wk As Worksheet
Dim header As Variant, final_arr As Variant
Dim x As Integer, y As Integer
Dim check As Boolean

arr = Sheets("Sheet1").Range("A1").CurrentRegion
ReDim final_arr(1 To (UBound(arr, 2) - 1), 1 To 1)
On Error Resume Next
Sheets("" & Sheets("Sheet2").Range("A1") & "").Delete
Set wk = Worksheets.Add(After:=Sheets(ThisWorkbook.Sheets.Count))
On Error GoTo 0
wk.Name = Sheets("Sheet2").Range("A1")
x = 1
Do
If arr(x, 1) = Sheets("Sheet2").Range("A1").Value Then
For y = 2 To UBound(arr, 2)
final_arr(y - 1, 1) = arr(x, y)
Next y
check = True
End If
x = x + 1
Loop While check = False
Sheets("Sheet1").Range("B1").Resize(1, UBound(arr, 2) - 1).Copy
wk.Range("A1").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
wk.Range("B1").Resize(UBound(final_arr, 1), 1).Value = final_arr

End Sub
Assuming you have data in sheet1 like this:

ABCDE
1ProjectOwnerStatusRiskTeam
2AJackOn TrackNoneNone
3BMaryRIskShort on fundingJoe, Mary, Mira
4CVickNeed HelpNeed more resourcesKayle, Mike

Sheet1

And Data in sheet2 like this:

ABC
1CButton Here
2
3
4

Sheet2  Reply With Quote

4. Re: Array + Transpose + Table

Thank you both!
RasGhul: What is in A2 cell in sheet2. Right now, its blank. Should I drag the formula in the column to B5?

Nishant, the VBA worked great. Not quite my strenght, but I managed to make this run. Thank you. Question though - what do I change in the code if the sheet 1 table starts from B7 to X7 and down to 25 rows? What if down the road I add more columns and rows? Can you highlight the section in the code that I can change?  Reply With Quote

5. Re: Array + Transpose + Table

Code:

Sub Create_Summary()

Dim arr As Variant
Dim wk As Worksheet
Dim header As Variant, final_arr As Variant
Dim x As Integer, y As Integer
Dim check As Boolean

arr = Sheets("Sheet1").Range("A1").CurrentRegion
ReDim final_arr(1 To (UBound(arr, 2) - 1), 1 To 1)
On Error Resume Next
Sheets("" & Sheets("Sheet2").Range("A1") & "").Delete
Set wk = Worksheets.Add(After:=Sheets(ThisWorkbook.Sheets.Count))
On Error GoTo 0
wk.Name = Sheets("Sheet2").Range("A1")
x = 1
Do
If arr(x, 1) = Sheets("Sheet2").Range("A1").Value Then
For y = 2 To UBound(arr, 2)
final_arr(y - 1, 1) = arr(x, y)
Next y
check = True
End If
x = x + 1
Loop While check = False
Sheets("Sheet1").Range("A1").Offset(0,1).Resize(1, UBound(arr, 2) - 1).Copy
wk.Range("A1").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
wk.Range("B1").Resize(UBound(final_arr, 1), 1).Value = final_arr

End Sub

Change the red ones with the first cell from where your table starts. For example if the table is G7:X25 then replace the red coloured text with G7. Even if you add more data it will automatically pick up the new data when you run the code.  Reply With Quote

6. Re: Array + Transpose + Table Originally Posted by Excel_pal Thank you both!
RasGhul: What is in A2 cell in sheet2. Right now, its blank. Should I drag the formula in the column to B5?

Nishant, the VBA worked great. Not quite my strenght, but I managed to make this run. Thank you. Question though - what do I change in the code if the sheet 1 table starts from B7 to X7 and down to 25 rows? What if down the road I add more columns and rows? Can you highlight the section in the code that I can change?
yes drag the formula down to B5, you can create a table version of this to make it dynamic if required but will need table reference change to the formula.

Nishants solution is also dynamic when setup correctly.  Reply With Quote

7. Re: Array + Transpose + Table Originally Posted by RasGhul yes drag the formula down to B5, you can create a table version of this to make it dynamic if required but will need table reference change to the formula.

Nishants solution is also dynamic when setup correctly.
Somehow it still is not working. I am getting #N/A in all the cells.  Reply With Quote

8. Re: Array + Transpose + Table

Sorry to bother you again, but I changed the sheet name also in the code to match with the original file. It messed up and showing error. I only changed the file name from Sheet1 to Project_List. I do have other sheets in the file. Could that have caused error?  Reply With Quote

9. Re: Array + Transpose + Table Originally Posted by Excel_pal Sorry to bother you again, but I changed the sheet name also in the code to match with the original file. It messed up and showing error. I only changed the file name from Sheet1 to Project_List. I do have other sheets in the file. Could that have caused error?
Code:
Sub Create_Summary()

Dim arr As Variant
Dim wk As Worksheet, tabsheet As Range, crsheet As Range
Dim header As Variant, final_arr As Variant
Dim x As Integer, y As Integer
Dim check As Boolean

'Change the sheet name from Sheet1 to anything where your table is
'and similarly change A1 to the cell reference from where your table starts
Set tabsheet = Sheets("Sheet1").Range("A1")
'The below line of code deals with the criteria sheet and range
'So you can chage the criteria sheet name from sheet2 to anything where you have your criteria
'and range from A1 to any cell reference where you have the criteria
Set crsheet = Sheets("Sheet2").Range("A1")

arr = tabsheet.CurrentRegion
ReDim final_arr(1 To (UBound(arr, 2) - 1), 1 To 1)
On Error Resume Next
Sheets("" & crsheet & "").Delete
Set wk = Worksheets.Add(After:=Sheets(ThisWorkbook.Sheets.Count))
On Error GoTo 0
wk.Name = crsheet
x = 1
Do
If arr(x, 1) = crsheet.Value Then
For y = 2 To UBound(arr, 2)
final_arr(y - 1, 1) = arr(x, y)
Next y
check = True
End If
x = x + 1
Loop While check = False
tabsheet.Offset(0, 1).Resize(1, UBound(arr, 2) - 1).Copy
wk.Range("A1").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
wk.Range("B1").Resize(UBound(final_arr, 1), 1).Value = final_arr

End Sub
I have marked the areas where you need to make changes and explained it by commenting it out in the code itself.  Reply With Quote

10. Re: Array + Transpose + Table

Here's a dropbox link to a mockup table version with a guide to how it is made for reference for your sheet.

Note that you should make a copy of your original file and see if you like the end result first before applying to your real file.

https://www.dropbox.com/s/6zm758ke1a...sion.xlsx?dl=0  Reply With Quote

User Tag List

Tags for this Thread

array, match - if, project, sheet, transpose  Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•