Need cell color via Macro

S

sksanjeev786

Well-known Member
Joined
Aug 5, 2020
Messages
961
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi Team,

Need support on Macro

I have the Main data from (A14 to I25) and
1. From A30 to I39 where ever we got an "X" letter i need a "GREEN" color on (A14 to I25)
2. From A43 to I51 whatever letter we have should match with Row 14 and need RED color on (A14 to I25)

INPUT :
Diversity Calculations - February 2023_KGDC.xlsm
ABCDEFGHI
14ABCDEFGH
15TOP 2 BOX (NET)49%50%42%52%42%61%39%53%
16(5) Agree strongly19%18%19%18%15%23%16%15%
17(4) Agree somewhat30%32%23%34%27%37%23%38%
18(3) Neither agree nor disagree35%35%37%26%37%28%37%28%
19BOTTOM 2 BOX (NET)16%15%21%22%21%12%25%18%
20(2) Disagree somewhat10%7%13%15%11%7%13%10%
21(1) Disagree strongly6%7%7%7%11%5%11%8%
22Sigma100%100%100%100%100%100%100%100%
23Mean347%347%333%341%325%367%319%342%
24S.D.110%110%114%116%116%106%119%112%
25S.E.9%9%9%10%9%9%10%10%
26
27
28Q. The People In The Ad (1)6566676869707172
29
30TOP 2 BOX (NET)495042524261 X3953
31(5) Agree strongly1918191815231615
32(4) Agree somewhat3032233427372338
33(3) Neither agree nor disagree3535372637283728
34BOTTOM 2 BOX (NET)161521 X22 X21 X1225 X18
35(2) Disagree somewhat1071315 X1171310
36(1) Disagree strongly677711 X511 X8
37Base(150)(137)(150)(137)(150)(137)(150)(137)
38Mean3.473.473.333.413.253.67 X3.193.42
39S.E.0.090.090.090.100.090.090.100.10
40
41
42TOP 2 BOX (NET)48 GQ48 GQ48 GQ48 GQ48 GQ48 GQ48 GQ48 GQ
43(5) Agree strongly18 QT18 QT18 QT18 QT18 QT18 QT18 QT18 QT
44(4) Agree somewhat31 CG31 CG31 CG31 CG31 CG31 CG31 CG31 CG
45(3) Neither agree nor disagree37 DFH37 DFH37 DFH37 DFH37 DFH37 DFH37 DFH37 DFH
46BOTTOM 2 BOX (NET)1515151515151515
47(2) Disagree somewhat99999999
48(1) Disagree strongly66666666
49Base
50Mean3.45 EGQ3.45 EGQ3.45 EGQ3.45 EGQ3.45 EGQ3.45 EGQ3.45 EGQ3.45 EGQ
51S.E.0.090.090.090.090.090.090.090.09
The People In The Ad
Cell Formulas
RangeFormula
B14:I14B14=CHAR(B28)



OUTPUT (Added color Manually)
Below is my output i have updated manually color on the cells:-

V1.xlsm
ABCDEFGHI
15TOP 2 BOX (NET)49%50%42%52%42%61%39%53%
16(5) Agree strongly19%18%19%18%15%23%16%15%
17(4) Agree somewhat30%32%23%34%27%37%23%38%
18(3) Neither agree nor disagree35%35%37%26%37%28%37%28%
19BOTTOM 2 BOX (NET)16%15%21%22%21%12%25%18%
20(2) Disagree somewhat10%7%13%15%11%7%13%10%
21(1) Disagree strongly6%7%7%7%11%5%11%8%
22Sigma100%100%100%100%100%100%100%100%
23Mean347%347%333%341%325%367%319%342%
24S.D.110%110%114%116%116%106%119%112%
25S.E.9%9%9%10%9%9%10%10%
The People In The Ad
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Sort by date Sort by votes
Try this:

VBA Code: 
Sub cell_color()
  Dim i As Long, j As Long
 
  For i = 30 To 39
    For j = 2 To 9
      If InStr(1, Cells(i, j).Value, "X") > 0 Then
        Cells(i - 15, j).Interior.Color = 4697456     'or vbgreen
      End If
    Next
  Next
 
  For i = 42 To 51
    For j = 2 To 9
      If InStr(1, Cells(i, j).Value, Cells(14, j)) > 0 Then
        Cells(i - 27, j).Interior.Color = 5263615   'or vbRed
      End If
    Next
  Next
End Sub

The same macro but compacted.
VBA Code: 
Sub cell_color()
  Dim i As Long, j As Long, m As Long
  Dim s As String, n
  
  For j = 2 To 9
    For i = 30 To 51
      Select Case i
        Case 30 To 40: s = "X":          m = 15: n = 4697456  'or vbgreen
        Case 42 To 51: s = Cells(14, j): m = 27: n = 5263615  'or vbRed
      End Select
      If InStr(1, Cells(i, j).Value, s) > 0 Then Cells(i - m, j).Interior.Color = n
    Next
  Next
End Sub
 
Last edited:
Upvote 1
Solution
With conditional formatting:

Dante Amor
ABCDEFGHI
14ABCDEFGH
15TOP 2 BOX (NET)0.490.50.420.520.420.610.390.53
16(5) Agree strongly0.190.180.190.180.150.230.160.15
17(4) Agree somewhat0.30.320.230.340.270.370.230.38
18(3) Neither agree nor disagree0.350.350.370.260.370.280.370.28
19BOTTOM 2 BOX (NET)0.160.150.210.220.210.120.250.18
20(2) Disagree somewhat0.10.070.130.150.110.070.130.1
21(1) Disagree strongly0.060.070.070.070.110.050.110.08
22Sigma11111111
23Mean3.473.473.333.413.253.673.193.42
24S.D.1.11.11.141.161.161.061.191.12
25S.E.0.090.090.090.10.090.090.10.1
The People In The Ad
Cell Formulas
RangeFormula
B14:I14B14=CHAR(B28)
Cells with Conditional Formatting
CellConditionCell FormatStop If True
B15:I25Expression=SEARCH(B$14,B42)textNO
B15:I25Expression=SEARCH("X",B30)textNO
 
Upvote 0
DanteAmor said:
Try this:

VBA Code: 
Sub cell_color()
  Dim i As Long, j As Long
 
  For i = 30 To 39
    For j = 2 To 9
      If InStr(1, Cells(i, j).Value, "X") > 0 Then
        Cells(i - 15, j).Interior.Color = 4697456     'or vbgreen
      End If
    Next
  Next
 
  For i = 42 To 51
    For j = 2 To 9
      If InStr(1, Cells(i, j).Value, Cells(14, j)) > 0 Then
        Cells(i - 27, j).Interior.Color = 5263615   'or vbRed
      End If
    Next
  Next
End Sub

The same macro but compacted.
VBA Code: 
Sub cell_color()
  Dim i As Long, j As Long, m As Long
  Dim s As String, n
 
  For j = 2 To 9
    For i = 30 To 51
      Select Case i
        Case 30 To 40: s = "X":          m = 15: n = 4697456  'or vbgreen
        Case 42 To 51: s = Cells(14, j): m = 27: n = 5263615  'or vbRed
      End Select
      If InStr(1, Cells(i, j).Value, s) > 0 Then Cells(i - m, j).Interior.Color = n
    Next
  Next
End Sub
Click to expand...
Hi Sir,

I was trying with the below MACRO and was not able to get Red Color but only Green Cells appeared with the below MAcro

I know I am missing something in the below line can you please help me on this :)

"
ElseIf InStr(1, Cells(x + 28, 132), Cells(1, y)) Then
'Change the text color
ActiveCell.Interior.Color = RedColor
"

MACRO

Sub changeTextColor()
GreenColor = RGB(0, 176, 80)
RedColor = RGB(192, 0, 0)
BlackColor = RGB(0, 0, 0)


'Select cell

Range("B15:EC25").HorizontalAlignment = xlCenter
Range("B15:EC25").VerticalAlignment = xlCenter
Range("B15:EC25").Select

'Loop the cells
For x = 15 To 25
For y = 2 To 132
Cells(x, y).Select
If InStr(1, ActiveCell.Offset(15, 0), "X") Then
'Change the text color
ActiveCell.Interior.Color = GreenColor
ElseIf InStr(1, Cells(x + 28, 132), Cells(1, y)) Then
'Change the text color
ActiveCell.Interior.Color = RedColor
Else
ActiveCell.Font.Color = BlackColor
End If
Next y
Next x

End Sub
 
Upvote 0
sksanjeev786 said:
Cells(x + 28, 132), Cells(1, y)
Click to expand...

According to your example from the initial post the numbers should be:
Rich (BB code): 
Cells(x + 27, y), Cells(14, y)

Then try:
VBA Code: 
Sub changeTextColor()
  Dim GreenColor As Long, RedColor As Long, BlackColor As Long
  Dim x As Long, y As Long
  
  GreenColor = RGB(0, 176, 80)
  RedColor = RGB(192, 0, 0)
  BlackColor = RGB(0, 0, 0)
  
  'Select cell
  With Range("B15:EC25")
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .Interior.ColorIndex = xlNone
    .Font.ColorIndex = xlNone
  End With
  
  'Loop the cells
  For x = 15 To 25
    For y = 2 To 132
      If InStr(1, Cells(x + 15, y), "X") Then
        Cells(x, y).Interior.Color = GreenColor   'Change the text color
      ElseIf InStr(1, Cells(x + 27, y), Cells(14, y)) Then
        Cells(x, y).Interior.Color = RedColor     'Change the text color
      Else
        Cells(x, y).Font.Color = BlackColor
      End If
    Next y
  Next x
End Sub
 
Upvote 0
DanteAmor said:
According to your example from the initial post the numbers should be:
Rich (BB code): 
Cells(x + 27, y), Cells(14, y)

Then try:
VBA Code: 
Sub changeTextColor()
  Dim GreenColor As Long, RedColor As Long, BlackColor As Long
  Dim x As Long, y As Long
 
  GreenColor = RGB(0, 176, 80)
  RedColor = RGB(192, 0, 0)
  BlackColor = RGB(0, 0, 0)
 
  'Select cell
  With Range("B15:EC25")
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .Interior.ColorIndex = xlNone
    .Font.ColorIndex = xlNone
  End With
 
  'Loop the cells
  For x = 15 To 25
    For y = 2 To 132
      If InStr(1, Cells(x + 15, y), "X") Then
        Cells(x, y).Interior.Color = GreenColor   'Change the text color
      ElseIf InStr(1, Cells(x + 27, y), Cells(14, y)) Then
        Cells(x, y).Interior.Color = RedColor     'Change the text color
      Else
        Cells(x, y).Font.Color = BlackColor
      End If
    Next y
  Next x
End Sub
Click to expand...
Awesome! thank you so much Sir, for your time on this :)
 
Upvote 1
You must log in or register to reply here.

Similar threads

S
  • Solved
Individual Ranking
2
Replies
11
Views
433
sksanjeev786
S
K
  • Question Question
conditional formatting question
Replies
2
Views
563
kerm007
K
Cubist
  • Question Question
Pivot Table with Overlapping Row
Replies
0
Views
239
Cubist
Cubist
A
  • Solved
Lookup PAAF ID based on Worker ID and date range
Replies
3
Views
112
Fluff
Fluff
F
  • Question Question
link two pivot table filters via vba
Replies
1
Views
117
Excelogist
E

Forum statistics

Threads
1,223,099
Messages
6,170,111
Members
452,302
Latest member
TaMere

Share this page

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