flemingg62
asked on
How to have consistent colouring of excel charts in many tabs
I have an excel file about 20 tabs of data and graphs and I want to have consistence colouring through out all tables
I have created a tap called Lookup Codes which contains all the description id all graphs headings and their associated colour.
I found some code on the web the almost works but I can't get it to work with all graphs in all tabs, any ideas
The attached file is a striped down file I have been using to get a basic solution and my VBA skills are basic
Color-chart-columns-by-cell-color1.xlsm
I have created a tap called Lookup Codes which contains all the description id all graphs headings and their associated colour.
I found some code on the web the almost works but I can't get it to work with all graphs in all tabs, any ideas
The attached file is a striped down file I have been using to get a basic solution and my VBA skills are basic
Color-chart-columns-by-cell-color1.xlsm
ASKER
Hi
Thanks I tried templates and I can't get it to keep the same colour for an item. i.e I want "Vacant" to be blue but Vacant can occur in a different position in the list. Sometime it is 4th, sometime it is 8th. The chart template appears to always assign the same colour to the row. i.e. the 3rd item will always the same colour no matter what the description is .
Thanks I tried templates and I can't get it to keep the same colour for an item. i.e I want "Vacant" to be blue but Vacant can occur in a different position in the list. Sometime it is 4th, sometime it is 8th. The chart template appears to always assign the same colour to the row. i.e. the 3rd item will always the same colour no matter what the description is .
Oh I see, that makes sense then to use VBA
kfalandays
kfalandays
Hi,
Regards
I have created a tap called Lookup Codes which contains all the description id all graphs headings and their associated colour.Could you send an example of that
Regards
pls try
Color-chart-columns-by-cell-color1-.xlsm
Sub ColorChartColumnsbyCellColor()
For Each sh In Worksheets
For Each chObj In sh.ChartObjects
With chObj.Chart.SeriesCollection(1)
Set vAddress = Range(Split(Split(.Formula, ",")(1), "!")(1))
For Idx = 1 To vAddress.Count
res = 0
On Error Resume Next ' find corresponding XValue
res = WorksheetFunction.Match(vAddress.Cells(Idx), Sheets("Sheet3").Range("A1:A5"), 0)
On Error GoTo 0
If res <> 0 Then ' if found
.Points(Idx).Format.Fill.ForeColor.RGB = Sheets("Sheet3").Range("A1").Offset(res - 1, 1).Interior.Color
End If
Next
End With
Next
Next
End Sub
RegardsColor-chart-columns-by-cell-color1-.xlsm
ASKER
Thanks Traveling for the next 2 days, will try on Friday
ASKER
Hi
Thanks for the code. I tried it and it works perfectly, bar one problem. Most of my graphs are Power Pivot and I keep getting out of ranges error. I have tried a few variations but no luck
I have attached a file that contains one power pivot tab (and 3 tabs of standard charts), any idea?
Test-colours-Charts-with-Power-Pivo.xlsm
Thanks for the code. I tried it and it works perfectly, bar one problem. Most of my graphs are Power Pivot and I keep getting out of ranges error. I have tried a few variations but no luck
I have attached a file that contains one power pivot tab (and 3 tabs of standard charts), any idea?
Test-colours-Charts-with-Power-Pivo.xlsm
Not at my usual place(unable to open the file)
I changed the first code to read directly the values of the chart
I changed the first code to read directly the values of the chart
Sub ColorChartColumnsbyCellColor()
Dim aXVal()
For Each sh In Worksheets
For Each chObj In sh.ChartObjects
With chObj.Chart.SeriesCollection(1)
aXVal = .XValues
For Idx = 1 To UBound(aXVal)
res = 0
On Error Resume Next ' find corresponding XValue
res = WorksheetFunction.Match(aXVal(Idx), Sheets("Sheet3").Range("A1:A5"), 0)
On Error GoTo 0
If res <> 0 Then ' if found
.Points(Idx).Format.Fill.ForeColor.RGB = Sheets("Sheet3").Range("A1").Offset(res - 1, 1).Interior.Color
End If
Next
End With
Next
Next
End Sub
then try ( your labels have to be unique not like in example: 2 "Meeting")
Sub ColorChartColumnsbyCellColor()
Dim aXVal()
For Each sh In Worksheets
For Each chObj In sh.ChartObjects
For Each SerCol In chObj.Chart.SeriesCollection
With SerCol
aXVal = .XValues
For Idx = 1 To UBound(aXVal)
res = 0
On Error Resume Next ' find corresponding XValue
res = WorksheetFunction.Match(aXVal(Idx), Sheets("Sheet1").Range("A2:A25"), 0)
On Error GoTo 0
If res <> 0 Then ' if found
.Points(Idx).Format.Fill.ForeColor.RGB = Sheets("Sheet1").Range("A2").Offset(res - 1, 2).Interior.Color
End If
Next
End With
Next
Next
Next
End Sub
ASKER
Hi
Thanks very much that solved the problem with power pivots. But when I run it in my main reports not all graphs are updated. In it I have a tab called Lookup Colours (to be hidden at the end) and 3 tabs update and 3 don't. I have set up a secondary column of grey so I can see the one that work ( I just change the column reference when I want to run a different colour scheme). Any Idea
Thanks again for you help so far.
BI-Depaartmental-Reports-9.xlsm
Thanks very much that solved the problem with power pivots. But when I run it in my main reports not all graphs are updated. In it I have a tab called Lookup Colours (to be hidden at the end) and 3 tabs update and 3 don't. I have set up a secondary column of grey so I can see the one that work ( I just change the column reference when I want to run a different colour scheme). Any Idea
Thanks again for you help so far.
BI-Depaartmental-Reports-9.xlsm
then try
Sub ColorChartColumnsbyCellColor()
Dim aXVal()
For Each sh In Worksheets
Debug.Print sh.Name
For Each chObj In sh.ChartObjects
With chObj.Chart.SeriesCollection(1)
aXVal = .XValues
For Idx = 1 To UBound(aXVal)
res = 0
On Error Resume Next ' find corresponding XValue
res = WorksheetFunction.Match(aXVal(Idx), Range(Sheets("LookUp Colours").Range("A1"), Sheets("LookUp Colours").Range("A" & Rows.Count).End(xlUp)), 0)
On Error GoTo 0
If res <> 0 Then ' if found
.Points(Idx).Format.Fill.ForeColor.RGB = Sheets("LookUp Colours").Range("A1").Offset(res - 1, 1).Interior.Color
End If
Next
End With
Next
Next
End Sub
You change the name of the sheet (case sensitive)
ASKER
Hi
Thanks and sorry to be a pain, but there is no change, i.e. graph in W1, W3 & M2 won't colour as per the tab "LookUp Colours".
And I assume the comment about case sensitive refers to "LookUp Colours".
Thanks and sorry to be a pain, but there is no change, i.e. graph in W1, W3 & M2 won't colour as per the tab "LookUp Colours".
And I assume the comment about case sensitive refers to "LookUp Colours".
runned the macro and this is the result where is the problem exactly
BI-Depaartmental-Reports-9v1.xlsm
BI-Depaartmental-Reports-9v1.xlsm
ASKER
When I run the code only half the charts are updated. If I switch the colour to use the grey colour in Column C of Lookup Colour
( .Points(Idx).Format.Fill.F oreColor.R GB = Sheets("LookUp Colours").Range("A1").Offs et(res - 1, 2).Interior.Color)
So all charts that change colour are Grey. You will see that not all charts are updated. i.e. Tab W3 won't update but tab W2 will
( .Points(Idx).Format.Fill.F
So all charts that change colour are Grey. You will see that not all charts are updated. i.e. Tab W3 won't update but tab W2 will
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Brilliant works a treat
No comment has been added to this question in more than 21 days, so it is now classified as abandoned.
I have recommended this question be closed as follows:
Accept: Rgonzo1971 (https:#a41730640)
If you feel this question should be closed differently, post an objection and the moderators will review all objections and close it as they feel fit. If no one objects, this question will be closed automatically the way described above.
frankhelk
Experts-Exchange Cleanup Volunteer
I have recommended this question be closed as follows:
Accept: Rgonzo1971 (https:#a41730640)
If you feel this question should be closed differently, post an objection and the moderators will review all objections and close it as they feel fit. If no one objects, this question will be closed automatically the way described above.
frankhelk
Experts-Exchange Cleanup Volunteer
Private Function ColorMyTab()
Dim iCntr, sht
'This will hold the colorIndex number
iCntr = 2
'looping throgh the all the sheets of the workbook
For Each sht In ThisWorkbook.Worksheets
iCntr = iCntr + 1
'Applying the colors to Sheet tabs
sht.Tab.ColorIndex = iCntr
Next
End Function
Dim iCntr, sht
'This will hold the colorIndex number
iCntr = 2
'looping throgh the all the sheets of the workbook
For Each sht In ThisWorkbook.Worksheets
iCntr = iCntr + 1
'Applying the colors to Sheet tabs
sht.Tab.ColorIndex = iCntr
Next
End Function
why do you need VBA? Why not just format one table and save it as a template? Then your formatting and colors will be listed in the chart types as your personal template
kfalandays