macro to automatically select certain cells.

[topi1]

I have a worksheet called "Home". Some of the cells from A1 to Z50 can be populated with the word "Yes". Is there a macro which when activated will only select (click) cells in the range which contain the word "Yes".

Thanks I advance for all your help.

 

[RatExcel]

Sub Select_Yes()

For Each cell In Range("A1:Z50")
    If cell.Value = "Yes" Then
        sel = sel & cell.Address & ","
    End If
Next

sel = Left(sel, Len(sel) - 1)

Range(sel).Select

End Sub

 

[topi1]

That is perfect. You are a savior. Thank you so much for the help all of you provide.

 

[topi1]

How do I add the above code at the end of the following macro and make it a part of that macro?
Thanks.




Sub STARTNew()
'
' STARTNew Macro
'

'


Range("B64").Select
Application.CutCopyMode = False
Selection.Copy

Range("E25,J25,L25").Select
Range("L25").Activate
ActiveSheet.Paste
Range("E29:L30").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("B28").Select
Selection.Copy
Range("N25:N28").Select
ActiveSheet.Paste

Range("B9").Select
Application.CutCopyMode = False
Selection.Copy
Range("O18,O21").Select
Range("O21").Activate
ActiveSheet.Paste
Range("O4:O15").Select
Range("O15").Activate
Application.CutCopyMode = False
Selection.ClearContents

Range("B30:B33").Select
Selection.Copy

Range("D19").Select
ActiveSheet.Paste

Range("B35:B47").Select
Application.CutCopyMode = False
Selection.Copy

Range("D3").Select
ActiveSheet.Paste

Range("B4").Select
Application.CutCopyMode = False
Selection.Copy
Range("J1").Select
ActiveSheet.Paste

End Sub

 

[RatExcel]

Just copy my code and paste it into your module as new sub. Then just add this line at the end of your code:

Call Select_Yes

 

[topi1]

Hi,
I think I did what you suggested. Here is what i get. However, I get the following error.
Thanks.
Compile Error:
Sub or Function not found

Sub STARTNew()
'
' STARTNew Macro
'
'



Range("B64").Select
Application.CutCopyMode = False
Selection.Copy

Range("E25,J25,L25").Select
Range("L25").Activate
ActiveSheet.Paste
Range("E29:L30").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("B28").Select
Selection.Copy
Range("N25:N28").Select
ActiveSheet.Paste

Range("B9").Select
Application.CutCopyMode = False
Selection.Copy
Range("O16,O20").Select
Range("O20").Activate
ActiveSheet.Paste
Range("O4:O15").Select
Range("O15").Activate
Application.CutCopyMode = False
Selection.ClearContents

Range("B30:B33").Select
Selection.Copy

Range("D19").Select
ActiveSheet.Paste

Range("B35:B47").Select
Application.CutCopyMode = False
Selection.Copy

Range("D3").Select
ActiveSheet.Paste

Range("B4").Select
Application.CutCopyMode = False
Selection.Copy
Range("J1").Select
ActiveSheet.Paste
For Each cell In Range("D1:Z50")
If cell.Value = "Yes" Then
sel = sel & cell.Address & ","
End If
Next
sel = Left(sel, Len(sel) - 1)
Range(sel).Select
Call Select_Yes

End Sub

 

[RatExcel]

There are two ways:

Sub STARTNew()
'
' STARTNew Macro
'
'
    
    
    
    Range("B64").Select
    Application.CutCopyMode = False
    Selection.Copy
    
    Range("E25,J25,L25").Select
    Range("L25").Activate
    ActiveSheet.Paste
    Range("E29:L30").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("B28").Select
    Selection.Copy
    Range("N25:N28").Select
    ActiveSheet.Paste
    
    Range("B9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("O16,O20").Select
    Range("O20").Activate
    ActiveSheet.Paste
    Range("O4:O15").Select
    Range("O15").Activate
    Application.CutCopyMode = False
    Selection.ClearContents
   
    Range("B30:B33").Select
    Selection.Copy
    
    Range("D19").Select
    ActiveSheet.Paste
    
    Range("B35:B47").Select
    Application.CutCopyMode = False
    Selection.Copy
    
    Range("D3").Select
    ActiveSheet.Paste
   
   Range("B4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("J1").Select
    ActiveSheet.Paste

For Each cell In Range("D1:Z50")
    If cell.Value = "Yes" Then
        sel = sel & cell.Address & ","
    End If
Next
sel = Left(sel, Len(sel) - 1)
Range(sel).Select

End Sub

or

Sub STARTNew()
'
' STARTNew Macro
'
'
    
    
    
    Range("B64").Select
    Application.CutCopyMode = False
    Selection.Copy
    
    Range("E25,J25,L25").Select
    Range("L25").Activate
    ActiveSheet.Paste
    Range("E29:L30").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("B28").Select
    Selection.Copy
    Range("N25:N28").Select
    ActiveSheet.Paste
    
    Range("B9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("O16,O20").Select
    Range("O20").Activate
    ActiveSheet.Paste
    Range("O4:O15").Select
    Range("O15").Activate
    Application.CutCopyMode = False
    Selection.ClearContents
   
    Range("B30:B33").Select
    Selection.Copy
    
    Range("D19").Select
    ActiveSheet.Paste
    
    Range("B35:B47").Select
    Application.CutCopyMode = False
    Selection.Copy
    
    Range("D3").Select
    ActiveSheet.Paste
   
   Range("B4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("J1").Select
    ActiveSheet.Paste

Call Select_Yes

End Sub



Sub Select_Yes()

For Each cell In Range("A1:Z50")
    If cell.Value = "Yes" Then
        sel = sel & cell.Address & ","
    End If
Next

sel = Left(sel, Len(sel) - 1)

Range(sel).Select

End Sub

 

[topi1]

Thank you much. I will try.

 

[topi1]

Too bad. It did not work. I get runtime error # 13. (Type mismatch). When I click on debug, it takes me to the following macro which is part of the worksheet.



Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Value = "No" Then
Target = "Yes"
ElseIf Target.Value = "Yes" Then
Target = "No"
End If
End Sub

 

[RatExcel]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

For Each cell In Target
    If cell.Value = "No" Then
        cell.Value = "Yes"
    ElseIf cell.Value = "Yes" Then
        cell.Value = "No"
    End If
Next

End Sub