Data Transposing with matching formatting and column headings

twinwings

Board Regular
Joined
Jul 25, 2012
Messages
69
Hello,

I am having some difficulty wrapping my head around this.

I know I can get a rough solution via pivot tables but I would like to explore the vba route as well.



I am looking for a macro that would take the following table from sheet1


[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]Name[/TD]
[TD]hair[/TD]
[TD]nose[/TD]
[TD]eyes[/TD]
[TD]ears[/TD]
[/TR]
[TR]
[TD]Donald[/TD]
[TD]high[/TD]
[TD]medium[/TD]
[TD]low[/TD]
[TD]na[/TD]
[/TR]
[TR]
[TD]Trump[/TD]
[TD]low[/TD]
[TD]na[/TD]
[TD]medium[/TD]
[TD]high[/TD]
[/TR]
</tbody>[/TABLE]






Where:
- High = red filled cell
- Medium = yellow filled cell
- Low = green filled cell
- na = no fill


And do the following

1) Transpose the data in another sheet, called sheet2
2) Instead of taking the "high/medium/low/na", the macro take the column headings such as "hair, nose, eyes, ears" and posts it beside the name
3) For the column in sheet2 that includes the column headings from sheet1, the column in sheet2 should say the headings in sheet1, by matching the color fill of the category.
eg. Hair - Donald, will have a red filled cell for "Hair" as it falls under "high" which is a red filled cell in sheet1.
eg. Eyes - Trump, will have a yellow filled cell for "Eyes" as it falls under "medium" which is a yellow filled cell in sheet 1.

The "solution" would look something like this

[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]Category[/TD]
[TD]Name[/TD]
[/TR]
[TR]
[TD]hair (red fill)[/TD]
[TD]Donald[/TD]
[/TR]
[TR]
[TD]nose (yellow fill)[/TD]
[TD]Donald[/TD]
[/TR]
[TR]
[TD]eyes ( green fill)[/TD]
[TD]Donald[/TD]
[/TR]
[TR]
[TD]hair (green fill)[/TD]
[TD]Trump[/TD]
[/TR]
[TR]
[TD]eyes (yellow fill)[/TD]
[TD]Trump[/TD]
[/TR]
[TR]
[TD]ears (red fill)[/TD]
[TD]Trump[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
















Note there's no Ears for Donald or Nose for Trump as they are both "na" and should not show up on sheet 2.


From what I saw, there's a lot of ways I can transpose, but I can't seem to find a transposition which takes the column headings instead of the data under the column headings while also omitting the data under the column headings (and omitting certain columns all together eg. if "na").


Any help is greatly appreciated.
 

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.
Hi twinwings,
this code should be more or less what you're looking for:

Code:
Sub transpose1()

Set Sht1 = Worksheets("Sheet1")
Set Sht2 = Worksheets("Sheet2")

r2 = 2
For r1 = 2 To 3
    For c1 = 2 To 6
        'Check for pattern: https://docs.microsoft.com/en-us/office/vba/api/excel.xlpattern
        Debug.Print Sht1.Cells(r1, c1).Interior.Color, Sht1.Cells(r1, c1).Interior.ColorIndex, Sht1.Cells(r1, c1).Interior.Pattern
        If Sht1.Cells(r1, c1).Interior.Pattern = xlPatternSolid And Sht1.Cells(r1, c1).Interior.Color <> 16777215 Then
            'Has color, not white, do something
            Sht2.Cells(r2, 1).Value = Sht1.Cells(1, c1).Value
            Sht2.Cells(r2, 1).Interior.Color = Sht1.Cells(r1, c1).Interior.Color
            Sht2.Cells(r2, 2).Value = Sht1.Cells(r1, 1).Value
            r2 = r2 + 1
        End If
    Next c1
Next r1

End Sub
Cheers,
Koen
 
Upvote 0
Thank you Koen, and my sincere apologies for the delay.


Your code does indeed work great but I am having some trouble "relocating" the code procedure to a different example where the NAME column is column B; and hair/nose/eyes/ears are columns I to L of Sheet1


[TABLE="class: cms_table_grid, width: 500, align: left"]
<tbody>[TR]
[TD]Name (column B)[/TD]
[TD]hair (column I)[/TD]
[TD]nose (column J)[/TD]
[TD]eyes (column K)[/TD]
[TD]ears (eyes (column L)[/TD]
[/TR]
[TR]
[TD]Donald (Cell B12)[/TD]
[TD]high[/TD]
[TD]medium[/TD]
[TD]low[/TD]
[TD]na[/TD]
[/TR]
[TR]
[TD]Trump[/TD]
[TD]low[/TD]
[TD]na[/TD]
[TD]medium[/TD]
[TD]high[/TD]
[/TR]
</tbody>[/TABLE]








and convert the above table into this in sheet2, but instead of starting at row 2, it starts at row11

[TABLE="class: cms_table_grid, width: 500, align: left"]
<tbody>[TR]
[TD]Category (but starting at cell A11 as opposed to A2)[/TD]
[TD]Name (but starting at cell B11 as opposed to B2)[/TD]
[/TR]
[TR]
[TD]hair (red fill)[/TD]
[TD]Donald[/TD]
[/TR]
[TR]
[TD]nose (yellow fill)[/TD]
[TD]Donald[/TD]
[/TR]
[TR]
[TD]eyes ( green fill)[/TD]
[TD]Donald[/TD]
[/TR]
[TR]
[TD]hair (green fill)[/TD]
[TD]Trump[/TD]
[/TR]
[TR]
[TD]eyes (yellow fill)[/TD]
[TD]Trump[/TD]
[/TR]
[TR]
[TD]ears (red fill)[/TD]
[TD]Trump[/TD]
[/TR]
</tbody>[/TABLE]















Here's what I have so far...but I can't seem to crack it


Sub transpose4()


Set Sht1 = Worksheets("Sheet1")
Set Sht2 = Worksheets("Sheet2")



r2 = 11
For r1 = 12 To 126 'r1 begins from row 12 to 126
'This selects length of names from tab1 to next tab.
For c1 = 9 To 12 'columbs b to g
Debug.Print Sht1.Cells(r1, c1).Interior.Color, Sht1.Cells(r1, c1).Interior.ColorIndex, Sht1.Cells(r1, c1).Interior.Pattern
If Sht1.Cells(r1, c1).Interior.Pattern = xlPatternSolid And Sht1.Cells(r1, c1).Interior.Color <> 16777215 Then
'if color not white, do something
Sht2.Cells(r2, 1).Value = Sht1.Cells(11, c1).Value
' first cell in row 2, column 1 in sheet2, is equal to the cell in first row, but starting count column in sheet1
Sht2.Cells(r2, 1).Interior.Color = Sht1.Cells(r1, c1).Interior.Color
' first cell in row 2, column 1 in sheet2, is equal to the cell color in first row which is actual row 2, but starting count column in sheet1
Sht2.Cells(r2, 2).Value = Sht1.Cells(r1, 2).Value
r2 = r2 + 1
End If
Next c1
Next r1


End Sub
 
Last edited:
Upvote 0
Hi twinwings,
check out the line that says: r2 = 11 (just before the loop). That's the row that's used to put the results. So change that to r2=2 to start your results on row 2.
Cheers,
Koen
 
Upvote 0
Hi twinwings,
check out the line that says: r2 = 11 (just before the loop). That's the row that's used to put the results. So change that to r2=2 to start your results on row 2.
Cheers,
Koen


Thank you for respoding Koen, but I can't seem to get it to work.

Just to clarify, your first code you sent works perfectly.

I am just trying to change where the data is located, and where it will be transposed to.

If my data in sheet1 looks like so (where there could be 100s of rows)

[TABLE="class: cms_table_grid, width: 500, align: left"]
<tbody>[TR]
[TD]Column B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[TD]H[/TD]
[TD]Column I[/TD]
[TD]Column J[/TD]
[TD]Column K[/TD]
[TD]Column L[/TD]
[/TR]
[TR]
[TD]Name[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]hair[/TD]
[TD]nose[/TD]
[TD]eyes[/TD]
[TD]ears[/TD]
[/TR]
[TR]
[TD]Donald[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]high[/TD]
[TD]medium[/TD]
[TD]low[/TD]
[TD]na[/TD]
[/TR]
[TR]
[TD]Trump[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]low[/TD]
[TD]na[/TD]
[TD]medium[/TD]
[TD]high[/TD]
[/TR]
</tbody>[/TABLE]













how can I convert this so it does this in sheet2

[TABLE="class: cms_table_grid, width: 500, align: left"]
<tbody>[TR]
[TD]Row1 Column A[/TD]
[TD]Row1 Column B[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Category (this heading is preset)[/TD]
[TD]Name(this heading is preset)[/TD]
[/TR]
[TR]
[TD]hair (red fill)[/TD]
[TD]Donald[/TD]
[/TR]
[TR]
[TD]nose (yellow fill)[/TD]
[TD]Donald[/TD]
[/TR]
[TR]
[TD]eyes ( green fill)[/TD]
[TD]Donald[/TD]
[/TR]
[TR]
[TD]hair (green fill)[/TD]
[TD]Trump[/TD]
[/TR]
[TR]
[TD]eyes (yellow fill)[/TD]
[TD]Trump[/TD]
[/TR]
[TR]
[TD]ears (red fill)[/TD]
[TD]Trump[/TD]
[/TR]
</tbody>[/TABLE]






































Essentially, the transposed output in sheet 2 will begin in row 11(columnA) as opposed to row 2 from my first request.
 
Upvote 0
Hi twinwings,
check out the line that says: r2 = 11 (just before the loop). That's the row that's used to put the results. So change that to r2=2 to start your results on row 2.
Cheers,
Koen

Hi Koen,

So this code does exactly what I need it to do

Sub transpose1()


Set Sht1 = Worksheets("Sheet1")
Set Sht2 = Worksheets("Sheet2")


r2 = 11
For r1 = 12 To 136 'r1 begins from row 2 to 126
'This selects length of names from tab1 to next tab.
For c1 = 9 To 13 'columbs b to g
Debug.Print Sht1.Cells(r1, c1).Interior.Color, Sht1.Cells(r1, c1).Interior.ColorIndex, Sht1.Cells(r1, c1).Interior.Pattern
If Sht1.Cells(r1, c1).Interior.Pattern = xlPatternSolid And Sht1.Cells(r1, c1).Interior.Color <> 16777215 Then
'if color not white, do something
Sht2.Cells(r2, 1).Value = Sht1.Cells(11, c1).Value
' first cell in row 2, column 1 in sheet2, is equal to the cell in first row, but starting count column in sheet1
Sht2.Cells(r2, 1).Interior.Color = Sht1.Cells(r1, c1).Interior.Color
' first cell in row 2, column 1 in sheet2, is equal to the cell color in first row which is actual row 2, but starting count column in sheet1
Sht2.Cells(r2, 2).Value = Sht1.Cells(r1, 2).Value
r2 = r2 + 1
End If
Next c1
Next r1


End Sub



However, although it can grab solid colours, it cannot grab conditional formatting? How can I make the highlighted line grab the conditional formatting.
 
Upvote 0
Hi twinwings,
I found this question online: https://stackoverflow.com/questions...m-a-conditional-formatting-in-excel-using-vba
You see the first answer comes up with "If you want to know the color of a cell that has been colored by a conditional formatting rule (CFR) then use .Range.DisplayFormat.Interior.Color¹."

So in your case:
Sht1.Cells(r1, c1).Interior.Color -> Sht1.Cells(r1, c1).DisplayFormat.Interior.Color
And
Sht1.Cells(r1, c1).Interior.Pattern -> Sht1.Cells(r1, c1).DisplayFormat.Interior.Pattern

That should do the trick.

Cheers,
Koen
P.S. If you paste your code here, please use the CODE tags, see my signature.
 
Upvote 0
Hi Koen,

Thank you so much for your help.

I thought it was more do to with "xlPatternAutomatic" but couldn't get anywhere.

It seems the below code finally does what I want it to do.

Thank you so much,



Code:
Sub transpose1()


Set Sht1 = Worksheets("Sheet1")
Set Sht2 = Worksheets("Sheet2")


r2 = 11
For r1 = 12 To 136 'r1 begins from row 2 to 126
'This selects length of names from tab1 to next tab.
    For c1 = 9 To 13 'columbs b to g
        Debug.Print Sht1.Cells(r1, c1).DisplayFormat.Interior.Color, Sht1.Cells(r1, c1).DisplayFormat.Interior.ColorIndex, Sht1.Cells(r1, c1).DisplayFormat.Interior.Pattern
        If Sht1.Cells(r1, c1).DisplayFormat.Interior.Pattern = xlPatternSolid And Sht1.Cells(r1, c1).DisplayFormat.Interior.Color <> 16777215 Then
            'if color not white, do something
            Sht2.Cells(r2, 1).Value = Sht1.Cells(11, c1).Value
            ' first cell in row 2, column 1 in sheet2, is equal to the cell in first row, but starting count column in sheet1
            Sht2.Cells(r2, 1).Interior.Color = Sht1.Cells(r1, c1).DisplayFormat.Interior.Color
            ' first cell in row 2, column 1 in sheet2, is equal to the cell color in first row which is actual row 2, but starting count column in sheet1
            Sht2.Cells(r2, 2).Value = Sht1.Cells(r1, 2).Value
            r2 = r2 + 1
        End If
    Next c1
Next r1


End Sub
 
Upvote 0

Forum statistics

Threads
1,223,903
Messages
6,175,284
Members
452,630
Latest member
OdubiYouth

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