Data Transposing with matching formatting and column headings

twinwings

Board Regular
Joined
Jul 25, 2012
Messages
61
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


Namehairnoseeyesears
Donaldhighmediumlowna
Trumplownamediumhigh

<tbody>
</tbody>






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

CategoryName
hair (red fill)Donald
nose (yellow fill)Donald
eyes ( green fill)Donald
hair (green fill)Trump
eyes (yellow fill)Trump
ears (red fill)Trump

<tbody>
</tbody>
















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.
 

Rijnsent

Well-known Member
Joined
Oct 17, 2005
Messages
1,151
Office Version
365
Platform
Windows
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
 

twinwings

Board Regular
Joined
Jul 25, 2012
Messages
61
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


Name (column B)hair (column I)nose (column J)eyes (column K)ears (eyes (column L)
Donald (Cell B12)highmediumlowna
Trumplownamediumhigh

<tbody>
</tbody>








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

Category (but starting at cell A11 as opposed to A2)Name (but starting at cell B11 as opposed to B2)
hair (red fill)Donald
nose (yellow fill)Donald
eyes ( green fill)Donald
hair (green fill)Trump
eyes (yellow fill)Trump
ears (red fill)Trump

<tbody>
</tbody>















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:

Rijnsent

Well-known Member
Joined
Oct 17, 2005
Messages
1,151
Office Version
365
Platform
Windows
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
 

twinwings

Board Regular
Joined
Jul 25, 2012
Messages
61
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)

Column BCDEFGHColumn IColumn JColumn KColumn L
Namehairnoseeyesears
Donaldhighmediumlowna
Trumplownamediumhigh

<tbody>
</tbody>













how can I convert this so it does this in sheet2

Row1 Column ARow1 Column B
2
3
4
5
6
7
8
9
Category (this heading is preset)Name(this heading is preset)
hair (red fill)Donald
nose (yellow fill)Donald
eyes ( green fill)Donald
hair (green fill)Trump
eyes (yellow fill)Trump
ears (red fill)Trump

<tbody>
</tbody>






































Essentially, the transposed output in sheet 2 will begin in row 11(columnA) as opposed to row 2 from my first request.
 

twinwings

Board Regular
Joined
Jul 25, 2012
Messages
61
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.
 

Rijnsent

Well-known Member
Joined
Oct 17, 2005
Messages
1,151
Office Version
365
Platform
Windows
Hi twinwings,
I found this question online: https://stackoverflow.com/questions/45122782/how-to-get-the-background-color-from-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.
 

twinwings

Board Regular
Joined
Jul 25, 2012
Messages
61
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
 

Forum statistics

Threads
1,082,135
Messages
5,363,345
Members
400,729
Latest member
Lisa McConachy

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top