Macro : Remove Green Color After Run Macro in Second

[muhammad susanto]

hi all..

i have code to filling mark "V" if cell contains background green color..
i want only the green color background is gone after i run macro in second...
how to make it in macro :

Sub Checklist_V()Dim cell As Range
Application.ScreenUpdating = False
With ActiveSheet
    For Each cell In .UsedRange
        If cell.Interior.ColorIndex = "14" Then cell.Value = "V"
    Next cell
End With
Application.ScreenUpdating = True
End Sub

any helps much appreciated...

 

[muhammad susanto]

hi Fluff i have still problem , how to join 2 code in a single code include your code :
this :

Sub Photo()

    Dim pic As Shape
    Dim picSource As Worksheet
    Dim cellFrames As Variant
    Dim index As Long
    
    Set picSource = Worksheets("SHeet1")
    index = 1
    For Each cellFrames In Range("$D$82:$J$87,$L$82:$R$87,$T$82:$AA$87,$AC$82:$AI$87").Areas
        Set pic = picSource.Shapes(index)
        pic.Copy
        ActiveSheet.Paste
        With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
            .Height = cellFrames.Height
            .Left = cellFrames.Left + ((cellFrames.Width - .Width) / 2)
            .Top = cellFrames.Top
        End With
        index = index + 1
    Next
    Do While picSource.Shapes.Count > 0
        picSource.Shapes(1).Delete
    Loop
End Sub


Option Explicit


Sub Checklist_V()


    Dim Cl As Range
    
    Application.ScreenUpdating = False
    With ActiveSheet
        For Each Cl In .UsedRange
            If Cl.Interior.ColorIndex = "14" And Not Cl.Value = "V" Then
                Cl.Value = "V"
            ElseIf Cl.Interior.ColorIndex = "14" And Cl.Value = "V" Then
                Cl.Interior.Color = xlNone
            End If
        Next Cl
    End With
    Application.ScreenUpdating = True
    
End Sub

 

[Fluff]

Add this before the End Sub in your first code

    Call Checklist_V

 

[muhammad susanto]

hi Fluff...not working compile error : option explicit line
here this code after join :

Sub Photo()

    Dim pic As Shape
    Dim picSource As Worksheet
    Dim cellFrames As Variant
    Dim index As Long
    
    Set picSource = Worksheets("SHeet1")
    index = 1
    For Each cellFrames In Range("$D$82:$J$87,$L$82:$R$87,$T$82:$AA$87,$AC$82:$AI$87").Areas
        Set pic = picSource.Shapes(index)
        pic.Copy
        ActiveSheet.Paste
        With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
            .Height = cellFrames.Height
            .Left = cellFrames.Left + ((cellFrames.Width - .Width) / 2)
            .Top = cellFrames.Top
        End With
        index = index + 1
    Next
    Do While picSource.Shapes.Count > 0
        picSource.Shapes(1).Delete
    Loop
 Call Checklist_V
End Sub


Option Explicit


Sub Checklist_V()


    Dim Cl As Range
    
    Application.ScreenUpdating = False
    With ActiveSheet
        For Each Cl In .UsedRange
            If Cl.Interior.ColorIndex = "14" And Not Cl.Value = "V" Then
                Cl.Value = "V"
            ElseIf Cl.Interior.ColorIndex = "14" And Cl.Value = "V" Then
                Cl.Interior.Color = xlNone
            End If
        Next Cl
    End With
    Application.ScreenUpdating = True
    
End Sub

 

[Fluff]

Option Explicit should go at the very top of the module (ie very first line)

 

[muhammad susanto]

not fully work...
for first running macro is well done...but when i click/run macro in second time (to remove green color) is wrong..
The Parameter is incorrect...

 

[Rick Rothstein]

Is this what you're after?

Sub Checklist_V()

    Dim Cl As Range
    
    Application.ScreenUpdating = False
    With ActiveSheet
        For Each Cl In .UsedRange
            If Cl.Interior.ColorIndex = "14" And Not Cl.Value = "V" Then
                Cl.Value = "V"
            ElseIf Cl.Interior.ColorIndex = "14" And Cl.Value = "V" Then
                Cl.Interior.Color = xlNone
            End If
        Next Cl
    End With
    Application.ScreenUpdating = True
    
End Sub

Here is another way to write this macro that does not involve any loops (should be faster if your UsedRange is very large since it will do all of the colored cells all at once rather than iterating each cell in the UsedRange one at a time)...

[table="width: 500"]
[tr]
	[td]Sub Checklist_V()
  Application.FindFormat.Clear
  Application.ReplaceFormat.Clear
  Application.FindFormat.Interior.ColorIndex = 14
  Application.ReplaceFormat.Interior.ColorIndex = xlColorIndexNone
  ActiveSheet.UsedRange.Replace "V", "V", xlWhole, SearchFormat:=True, ReplaceFormat:=True
  Application.ReplaceFormat.Interior.ColorIndex = 31
  ActiveSheet.UsedRange.Replace "", "V", xlWhole, SearchFormat:=True, ReplaceFormat:=True
  Application.FindFormat.Clear
  Application.ReplaceFormat.Clear
End Sub[/td]
[/tr]
[/table]

 

[muhammad susanto]

HI Rick, i can't see change anything...

 

[Rick Rothstein]

HI Rick, i can't see change anything...

It worked on my system when I tested it before posting it... if the cell's ColorIndex was 14 and did not have an upper case V in it, it put an upper case V in that cell... if the cell's ColorIndex was 14 and it had an upper case V in it, the color was removed from the cell.

 

[muhammad susanto]

I did not still not work...i want to joint 2 code in a singe code...

 

[Rick Rothstein]

I did not still not work...i want to joint 2 code in a singe code...

Does my code work if you run it separately by itself?