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

Question

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

venkat1926 · Answer

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 jEnd Sub



Sub undo()Worksheets("sheet1").Cells.ClearWorksheets("sheet2").Cells.Copy Worksheets("sheet1").Range("A1")End Sub

jain.prashant31 · Answer

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.

venkat1926 · Answer

try to defind row1 and rowend and then use the macro 

if there is problem post your macro. your data also will be useful

jain.prashant31 · Answer

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

venkat1926 · Answer

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

jain.prashant31 · Answer

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

venkat1926 · Answer

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.ClearWorksheets("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

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

7 responses

Similar discussions

Subscribe To Our Newsletter!