PDA

View Full Version : [SOLVED] Using VBA to format multiple cells of a sheet based on the cells value of another she



shaeto
08-28-2015, 06:07 AM
Dear Community,

I would be grateful if you could please provide me with suggestions regarding the following:

I have a worksheet (Sheet4) whereby users will be inputting some text. Each entry is related to a date which is displayed into another cell.
I'm looking for a way (VBA Code or Formula) to colour the corresponding date cell which is found in another worksheet (Sheet3).

In a nutshell the idea is:

IF cell B6 or cell D6 of Sheet4 contains any text value Then
colour format cell B3 of Sheet3
Else
Do not format cell colour of B3 (Sheet3)

So,




Sheet4

Sheet3


IF B6 or D6 has any text value
Then
B3 is filled in red


IF B7 or D7 has any text value
Then
J3 is filled in red


IF B8 or D8 has any text value
Then
R3 is filled in red


IF B9 or D9 has any text value
Then
Z3 is filled in red


IF B10 or D10 has any text value
Then
AH3 is filled in red



I tried to use the in-built conditional formatting tool but there is a lot of cell to apply same to.
As a novice, I try VBA and came up with the following:


Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim var1 As String, var2 As String
var1 = Len(Worksheets("Sheet4").Range("B6"))
var2 = Len(Worksheets("Sheet4").Range("D6"))If var1 > 0 Then
Worksheets("Sheet3").Range("B3").Interior.Color = RGB(255, 0, 0)
Else
Worksheets("Sheet3").Range("B3").Interior.Color = xlNone
End If
If var2 > 0 Then
Worksheets("Sheet3").Range("B3").Interior.Color = RGB(255, 0, 0)
Else
Worksheets("Sheet3").Range("B3").Interior.Color = xlNone
End If
End Sub

The above works fine but is quite tedious.

Attached is a sample workbook, the above code is found in sheet2.

Thank you beforehand for your comments and recommendations.

Best regards,

Shameem

SamT
08-28-2015, 11:47 AM
Put this in Sheet2

Private Sub Worksheet_Change(ByVal Target As Range)
If Not (Intersect(Range("B:B"), Target) Is Nothing) _
And (Intersect(Range("D:D"), Target) Is Nothing) Then _
ColorCells Target
End Sub


Sub ColorCells(Rng As Range)
Dim DateSheet As Worksheet
Set DateSheet = ThisWorkbook.Sheets("Sheet3")
Dim Col As String

Select Case Rng.Row
Case 6: Col = "B"
Case 7: Col = "J"
Case 8: Col = "R"
Case 9: Col = "Z"
Case 10: Col = "AH"
End Select

With DateSheet.Range(Col & "3").Interior
If Rng.Value = "" Then
.ColorIndex = xlColorIndexNone
Else
.ColorIndex = 3
End If
End With
End Sub

shaeto
08-30-2015, 10:46 PM
Thanks a lot SamT.

It works like a charm.

Cheers

Shameem