Need cell color via Macro

sksanjeev786 · Feb 17, 2023

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

A

B

C

D

E

F

G

H

I

14

15

TOP 2 BOX (NET)

49%

50%

42%

52%

42%

61%

39%

53%

16

(5) Agree strongly

19%

18%

19%

18%

15%

23%

16%

15%

17

(4) Agree somewhat

30%

32%

23%

34%

27%

37%

23%

38%

18

(3) Neither agree nor disagree

35%

37%

26%

37%

28%

37%

28%

19

BOTTOM 2 BOX (NET)

16%

15%

21%

22%

21%

12%

25%

18%

20

(2) Disagree somewhat

10%

7%

13%

15%

11%

7%

13%

10%

21

(1) Disagree strongly

6%

7%

11%

5%

11%

8%

22

Sigma

100%

23

Mean

347%

333%

341%

325%

367%

319%

342%

24

S.D.

110%

114%

116%

106%

119%

112%

25

S.E.

9%

10%

9%

10%

26

27

28

Q. The People In The Ad (1)

65

66

67

68

69

70

71

72

29

30

TOP 2 BOX (NET)

49

50

42

52

42

61 X

39

53

31

(5) Agree strongly

19

18

19

18

15

23

16

15

32

(4) Agree somewhat

30

32

23

34

27

37

23

38

33

(3) Neither agree nor disagree

35

37

26

37

28

37

28

34

BOTTOM 2 BOX (NET)

16

15

21 X

22 X

21 X

12

25 X

18

35

(2) Disagree somewhat

10

7

13

15 X

11

7

13

10

36

(1) Disagree strongly

6

7

11 X

5

11 X

8

37

Base

(150)

(137)

(150)

(137)

(150)

(137)

(150)

(137)

38

Mean

3.47

3.33

3.41

3.25

3.67 X

3.19

3.42

39

S.E.

0.09

0.10

0.09

0.10

40

41

42

TOP 2 BOX (NET)

48 GQ

43

(5) Agree strongly

18 QT

44

(4) Agree somewhat

31 CG

45

(3) Neither agree nor disagree

37 DFH

46

BOTTOM 2 BOX (NET)

15

47

(2) Disagree somewhat

9

48

(1) Disagree strongly

6

49

Base

50

Mean

3.45 EGQ

51

S.E.

0.09

The People In The Ad

Cell Formulas
Range	Formula
B14:I14	B14	=CHAR(B28)

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

V1.xlsm

A

B

C

D

E

F

G

H

I

15

TOP 2 BOX (NET)

49%

50%

42%

52%

42%

61%

39%

53%

16

(5) Agree strongly

19%

18%

19%

18%

15%

23%

16%

15%

17

(4) Agree somewhat

30%

32%

23%

34%

27%

37%

23%

38%

18

(3) Neither agree nor disagree

35%

37%

26%

37%

28%

37%

28%

19

BOTTOM 2 BOX (NET)

16%

15%

21%

22%

21%

12%

25%

18%

20

(2) Disagree somewhat

10%

7%

13%

15%

11%

7%

13%

10%

21

(1) Disagree strongly

6%

7%

11%

5%

11%

8%

22

Sigma

100%

23

Mean

347%

333%

341%

325%

367%

319%

342%

24

S.D.

110%

114%

116%

106%

119%

112%

25

S.E.

9%

10%

9%

10%

The People In The Ad

DanteAmor · Feb 17, 2023

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

DanteAmor · Feb 17, 2023

With conditional formatting:

Dante Amor

A

B

C

D

E

F

G

H

I

14

15

TOP 2 BOX (NET)

0.49

0.5

0.42

0.52

0.42

0.61

0.39

0.53

16

(5) Agree strongly

0.19

0.18

0.19

0.18

0.15

0.23

0.16

0.15

17

(4) Agree somewhat

0.3

0.32

0.23

0.34

0.27

0.37

0.23

0.38

18

(3) Neither agree nor disagree

0.35

0.37

0.26

0.37

0.28

0.37

0.28

19

BOTTOM 2 BOX (NET)

0.16

0.15

0.21

0.22

0.21

0.12

0.25

0.18

20

(2) Disagree somewhat

0.1

0.07

0.13

0.15

0.11

0.07

0.13

0.1

21

(1) Disagree strongly

0.06

0.07

0.11

0.05

0.11

0.08

22

Sigma

1

23

Mean

3.47

3.33

3.41

3.25

3.67

3.19

3.42

24

S.D.

1.1

1.14

1.16

1.06

1.19

1.12

25

S.E.

0.09

0.1

0.09

0.1

The People In The Ad

Cell Formulas
Range	Formula
B14:I14	B14	=CHAR(B28)

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
B15:I25	Expression	=SEARCH(B$14,B42)	text	NO
B15:I25	Expression	=SEARCH("X",B30)	text	NO

sksanjeev786 · Feb 17, 2023

Thank you so much

, DanteAmor

It really saves a lot of time.

sksanjeev786 · Feb 17, 2023

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

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

DanteAmor · Feb 17, 2023

sksanjeev786 said:
Cells(x + 28, 132), Cells(1, y)

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

sksanjeev786 · Feb 18, 2023

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

Awesome! thank you so much Sir, for your time on this

Need cell color via Macro

sksanjeev786

Well-known Member

Excel Facts

DanteAmor

Well-known Member

DanteAmor

Well-known Member

sksanjeev786

Well-known Member

sksanjeev786

Well-known Member

DanteAmor

Well-known Member

sksanjeev786

Well-known Member

Similar threads

Forum statistics

Share this page

Need cell color via Macro

sksanjeev786

Well-known Member

Excel Facts

DanteAmor

Well-known Member

DanteAmor

Well-known Member

sksanjeev786

Well-known Member

sksanjeev786

Well-known Member

DanteAmor

Well-known Member

sksanjeev786

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock