SOLVED

Setting a cell's value and background colour through VBA

Brass Contributor

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

 

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

 

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.

 

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

 

The code I have written is

 

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 -

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

1 Reply
best response confirmed by PMHunt1955 (Brass Contributor)
Solution

@PMHunt1955 

 

Matter is now resolved through use of a Worksheet_Activate sub-routine.

 

Code =

 

Private Sub Worksheet_Activate()

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

Dim I As Long

Set wb = ThisWorkbook
Set wsPrime = wb.Worksheets("Coverage_Statistics") 'Targets Coverage_Statistics for placement of Table of Contents

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

Set rng = wsPrime.Range("A1:B" & 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 I

End Sub

1 best response

Accepted Solutions
best response confirmed by PMHunt1955 (Brass Contributor)
Solution

@PMHunt1955 

 

Matter is now resolved through use of a Worksheet_Activate sub-routine.

 

Code =

 

Private Sub Worksheet_Activate()

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

Dim I As Long

Set wb = ThisWorkbook
Set wsPrime = wb.Worksheets("Coverage_Statistics") 'Targets Coverage_Statistics for placement of Table of Contents

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

Set rng = wsPrime.Range("A1:B" & 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 I

End Sub

View solution in original post