Function or Macro to read cells in a column and color them [Closed]

Report
Posts
4
Registration date
Tuesday April 1, 2014
Status
Member
Last seen
April 10, 2014
-
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
-
Hi Guys,

I need to write a VBA macro or a formula/function, which actually reads the value and color of cells in column and in turn color other cells based on the requirement.

I'm not a coding guy and haven't been able to do this on my own though have been trying to do so from three days. If some of you can help me with the code it will be helpful.

My requirement is as follow :
Macro need to work on selection.
In the selection, for any cell filled with green color and value XYZ, other cells with value XYZ should also get colored to color green.

This is the only requirement I've.

Assistance would be much appreaciated !

In turn I can advise people on stuffs realted to SAP-GRC and Security whenever they need.

Regards,
Prashant Jain

7 replies

Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
791
it all depends upon the configuration of your sheet
sending workbook download from this url

http://speedy.sh/WvBX6/prashant-140401.xlsm


original data is FIRST ALREADY COPIED to sheet2 (see sheet2)

the macro "test" is in vb editor
run undo first and then test

also repeated here. (macro undo is to undo the result of macro)
YOUR COMMENTS PLEASE

Sub test()
Dim rowfirst As Integer, rowend As Integer, j As Integer, r As Range, c As Range, ccolor
Dim vvalue
Worksheets("sheet1").Activate
Set r = Range("A1").CurrentRegion
rowfirst = Range("A2").Row
rowend = Range("A2").End(xlDown).Row
For j = rowfirst To rowend
'Debug.Print j
Set r = Range(Cells(j, "A"), Cells(j, "A").End(xlToRight))
For Each c In r
'c.Select
If c.Interior.Color <> RGB(255, 255, 255) Then
ccolor = c.Interior.ColorIndex
vvalue = c.Value
Exit For
End If
Next c
If ccolor = "" Then GoTo nextj
For Each c In r
If c = vvalue Then c.Interior.ColorIndex = ccolor
Next c
ccolor = ""
nextj:
Next j
End Sub



Sub undo()
Worksheets("sheet1").Cells.Clear
Worksheets("sheet2").Cells.Copy Worksheets("sheet1").Range("A1")
End Sub
1
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 2942 users have said thank you to us this month

Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
791
try to defind row1 and rowend and then use the macro

if there is problem post your macro. your data also will be useful
1
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 2942 users have said thank you to us this month

Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
791
it is not clear what you want to do different from the macro I am giving. you study the macro given by me .

now you tell me what you want to do in logical steps 1,2,3,4,etc.
some sort of flow diagram for yourself and then start write the macro

you can also do one more thing.
under ribbon click record macro
accept macro name given
now do what you what you want to do in the data
after finishing that click stop macro

now open the macro and it may need some editing

try a few experiments.

ALWAYS KEEP ORIGINAL DATA IN ANOTHER SHEET SO THATyou can UNDO THE RESULT OF THE MACRO (see my undo macro)

This nesgsroup will always be ready to help people to learn how to write a macro
1
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 2942 users have said thank you to us this month

Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
791
my earlier macro does the same except that it does for the whole sheet. If you are interested only in a range of the sheet then redefine ristrow and end row

for e..g
firstrow=2
endrow=7
and keep the other items. I have slightly modified

see a new file which you can donwoad from

http://speedy.sh/Bqq8x/prashant-version2-140410.xlsm

though there are 12 rows in the sheet you are intersted only in the range A1 to E7


see the revised macro for this (undo is repeated for completion sake

Sub undo()
Worksheets("sheet1").Cells.Clear
Worksheets("sheet2").Cells.Copy Worksheets("sheet1").Range("A1")
End Sub

Sub testone()
Dim rowfirst As Integer, rowend As Integer, j As Integer, r As Range, c As Range, ccolor
Dim vvalue, r1 As Range
Worksheets("sheet1").Activate
Set r1 = Range("A1:E7")

rowfirst = 2
rowend = 7
For j = rowfirst To rowend
Debug.Print j
If j > rowend Then Exit For
Set r = Range(Cells(j, "A"), Cells(j, "A").End(xlToRight))
'MsgBox r.Address
For Each c In r
'c.Select
If c.Interior.Color <> RGB(255, 255, 255) Then
ccolor = c.Interior.ColorIndex
vvalue = c.Value
Exit For
End If
Next c
If ccolor = "" Then GoTo nextj
For Each c In r
If c = vvalue Then c.Interior.ColorIndex = ccolor
Next c
ccolor = ""
nextj:
Next j

End Sub
1
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 2942 users have said thank you to us this month

Posts
4
Registration date
Tuesday April 1, 2014
Status
Member
Last seen
April 10, 2014

Thanks a bunch Venkat !!

Its something very close to my requirement and working fine.

I was just trying to modify it so that the macro works only on the selected range of cells when I execute it.. or probably selected column.. I don't want it to run on the whole sheet..
Sadly I'm not able to make the changes.. Can you guide me on this change. How to make macro work only on selected cells.
Posts
4
Registration date
Tuesday April 1, 2014
Status
Member
Last seen
April 10, 2014

I'm very new to VB and not aware of syntaxes and all in it.

I tried to make some changes in the code. Now its working for me in column A. But not sure how to make it work on selection. Please suggest.



Sub test2()
Dim rowfirst As Integer, rowend As Integer, j As Integer, r As Range, c As Range, ccolor
Dim vvalue
rowfirst = Range("A2").Row

rowend = Range("A2").End(xlDown).Row
For j = rowfirst To rowend
'Debug.Print j

Set r = Range(Cells(j, "A"), Cells(j, "A").End(xlDown))
For Each c In r
'c.Select
If c.Interior.Color <> RGB(255, 255, 255) Then
ccolor = c.Interior.ColorIndex
vvalue = c.Value
Exit For
End If
Next c
If ccolor = "" Then GoTo nextj
For Each c In r
If c = vvalue Then c.Interior.ColorIndex = ccolor
Next c
ccolor = ""
nextj:
Next j
End sub
Posts
4
Registration date
Tuesday April 1, 2014
Status
Member
Last seen
April 10, 2014

Apologies if I've been confusing you all. Here is detailed description of what I need.

1 - Macro applies to Column A from row 2, till data is there.
2 - Macro reads the cell color one by one in column A, starting from A2,A3... and so on. If the cell color is RGB(146,208,80), then it read the text in the cell and let it be ASDF.
3 - Now it again starts from cell A2 and matches the text ASDF in first column checking A2,A3 and so on.. Where ever the text matches, it colors that cell with RGB(146,208,80) or if feasible the complete row with the color. For example A45 had text ASDF, so it colors the full row in RGB(146,208,80).

This operation is repeated for all cells in the column until it reaches the end of the range with data.


Let me know if I'm clear this time.

Regards,
Prashant Jain