Setting a cell's value and background colour through VBA

cuddling101

New Member
Joined
Feb 10, 2009
Messages
34
I have a workbook with 93 'key' worksheets. The background for each of the tabs is one of nine colours. I am now trying to make the contents of a sequence of cells on another worksheet, within the same workbook, the name of one of the worksheets, in succession, and colour the cell with the same background colour as the tab from which the cell's value has been drawn.

I successfully used the following function to make the cell values the required value in each cell, obviously the function is called from each cell.

Setting a Cell's Value

Code:
Function Other_Worksheet_Name_GSU(WS_Number As Long)

Dim fWS_Number As Long

fWS_Number = WS_Number

Other_Worksheet_Name_GSU = Sheets(fWS_Number).Name

End Function

I then successfully used the following function to retrieve the tab background colour.

Getting the background colour of a tab

Code:
Function Get_Tab_Colour(WS_Number As Long)

Dim fWS_Number As Long

fWS_Number = WS_Number

Get_Tab_Colour = Sheets(fWS_Number).Tab.Color

End Function

That function returns single numeric values such as - 13395711, 255, 42495, 65535, 65280, 16776960, 15119490. That does not readily convert, to my eyes, to a set of RGB or HSB values, but I am hoping that, as that was what was returned from a look into the Tab.Color property, Excel/VBA will be able to use that value appropriately.

I then tried to combine the two into one function, and that is where I have hit problems.

The code I have written is

Code:
Function Set_GSU_Value_and_Format(targetCell As String, WS_Number As Long)

Dim ftargetCell As String
Dim fWS_Number As Long
Dim fTab_Colour As Long

ftargetCell = targetCell

fWS_Number = WS_Number

fTab_Colour = Sheets(fWS_Number).Tab.Color

Range(ftargetCell).Interior.Color = fTab_Colour

Set_GSU_Value_and_Format = Sheets(fWS_Number).Name

End Function

I call the function using the following call -

=Set_GSU_Value_and_Format((ADDRESS((ROW()),(COLUMN()),4)),(ROW()-1))

which gets sent to the VBA as Set_GSU_Value_and_Format(A2,1).

I also tried to just set a cell's colour using similar code as follows -

Code:
Function Set_Cell_Colour(targetCell As String, WS_Number As Long)

Dim fWS_Number As Long
Dim ftargetCell As String
Dim fTab_Colour As Long

ftargetCell = targetCell

fWS_Number = WS_Number

fTab_Colour = Sheets(fWS_Number).Tab.Color

Range(ftargetCell).Interior.Color = fTab_Colour

End Function

I have tried both the following calls -

Formula based approach

=Set_Cell_Colour((ADDRESS((ROW()),(COLUMN()),4)),(ROW()-1))

which ends up sending Set_Cell_Colour(A2,1)


Literal approach

= Set_Cell_Colour("A2",1)


In both the formula based, and literal, approach to calling Set_Cell_Colour I get a #VALUE error.

I also get a #VALUE error with the call to Set_GSU_Value_and_Format.

The literal approach is only done for testing; I want to be able to use a formula approach, in the long run.

With hopes for some learned help, please and many thanks in anticipation.

Philip
Bendigo, Victoria
Australia
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
Hi, generally I've found that functions are not supposed to do formatting as per spec, but I think there might be a workaround. I'll see if I can figure it out.
 
Upvote 0
If you are ok with a subroutine, this will do what you want (I think).

Code:
 Sub CreateList()    
    Dim wb As Workbook
    Dim ws() As Worksheet
    Dim rng As Range
    Dim rngNow As Range
    Dim wsCount As Integer
    Dim wsColor() As String
    Dim wsPrime As Worksheet
    
    Set wb = ThisWorkbook
    Set wsPrime = wb.Worksheets("MacroTest") 'Put name of sheet with names here
    
    wsCount = Worksheets.Count
    
    Set rng = wsPrime.Range("A1:T" & wsCount)
    ReDim ws(1 To wsCount)
    ReDim wsColor(1 To wsCount)
    
   
    
    For i = 1 To wsCount
    
        Set ws(i) = Worksheets(i)
        wsColor(i) = ws(i).Tab.color
        Set rngNow = rng(i + 1, 1)
        rngNow.Interior.color = wsColor(i)
        rngNow = ws(i).Name
        
    Next


End Sub

All you need to do here is replace the name of the Table of Contents sheet with your sheets name. That's in the wsPrime variable. Below is a test worksheet of mine where I used the above sub.

8DBcI3G.jpg
 
Last edited:
Upvote 0
If you are ok with a subroutine, this will do what you want (I think).

Thank you for that. My only issue is that I have never been that savvy about sub-routines. I am not sure where I would place the code and how and when I would invoke the subroutine. Your advice regarding those points would be welcome, please. I seem to recall something about ON 'Event' coding and putting the code in the VBA for the 'table of contents' sheet, but I am not sure.

Best regards

Philip
 
Upvote 0
I got it to work by putting your code in a Worksheet_Activate event. I just had one more tweak that would be nice to include. You coded
Code:
wsCount = Worksheets.Count

I made it a literal

Code:
 wsCount = 93

I would really like it to be

Code:
 wsCount = Main_Families_Count

which is a named cell in that worksheet, but it did not like that.

Is the problem there because it is a cell in that worksheet, so it doesn't recognise that name at the worksheet.activate event point or do I have to pass it in to the subroutine in the brackets or what?

I worked it out, it needed to be

Code:
 wsCount = wb.Names("Main_Families_Count").RefersToRange.Value

Thank you for your help - this matter is now sorted.

Philip
 
Last edited:
Upvote 0
Hi Philip,

Glad to hear you got it working. As for how to get subroutines to work, it depends on how often it is going to be used. To me it seemed like a one use type thing, or a rarely used sub, so for that you can run the code manually in the VB Editor. Once the code is copied into a module, you would press F5, or press the Play button up top. That's a good way to learn how the code works too, as you can set little breakpoints in it, or use F8 to Step Into each line.

Best,

Scott
 
Upvote 0

Forum statistics

Threads
1,214,979
Messages
6,122,550
Members
449,088
Latest member
davidcom

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