Need cell color via Macro

S

sksanjeev786

Well-known Member
Joined
Aug 5, 2020
Messages
884
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

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
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

K
  • Question
conditional formatting question
Replies
2
Views
222
kerm007
K
Cubist
  • Question
Pivot Table with Overlapping Row
Replies
0
Views
121
Cubist
Cubist
S
  • Question
need ranking
Replies
5
Views
138
Cubist
Cubist
F
  • Solved
Sort scripture references by chapter number
Replies
9
Views
255
Peter_SSs
Peter_SSs
V
  • Question
MAx Date and Time
2
Replies
16
Views
684
awoohaw
awoohaw

Forum statistics

Threads
1,215,968
Messages
6,127,983
Members
449,414
Latest member
sameri

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