Loop that only works on specific columns?

[jmpatrick]

Hello, again.

This macro works great if I run it on any cell in Column C, or if I select several cells in Column C. What I need is for it to do it's magic (add a . to the existing value if one does not exist) on Column C AND Column AS no matter which cells/columns the user selects. Make sense?

For instance, if I selected G10:G50 and run the macro I want it to only to affect C10:C50 and AS10:AS50. It sounds like a job for ActiveCell.Row, but I can't figure out how to incorporate it. Here's what I have now:

Sub MarkConfirmed()

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Dim x As Variant

    If InStr(Worksheets("Calendar").Range("C" & ActiveCell.Row).Value, ".") Then GoTo SkipConfirm
    For Each x In Worksheets("Holidays").Range("HolidaysAll").Value
        If InStr(Worksheets("Calendar").Range("C" & ActiveCell.Row).Value, x) Then GoTo SkipConfirm
    Next
    
    ActiveSheet.Unprotect

    Dim c As Range
    For Each c In Selection
    If c.Value <> "" Then c.Value = c.Value & "."
    Next
    
    'Protect Calendar
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True

SkipConfirm:

    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
End Sub

 

[Akuini]

Try:

    Dim c As Range
    For Each c In Selection
    If c.Value <> "" Then
        c.Value = c.Value & "."
        Cells(c.Row, "AS") = Cells(c.Row, "AS") & "."
    End If
    Next

 

[Akuini]

Sorry, for col AS, do you mean if col AS is not empty then add "." ?
If so then the code in post #2 is wrong.

 

[jmpatrick]

Sorry, for col AS, do you mean if col AS is not empty then add "." ?
If so then the code in post #2 is wrong.

The code that adds the . on col C should also add one in col AS of the same row.

 

[Akuini]

The code that adds the . on col C should also add one in col AS of the same row.

Ok, then just try the code.

 

[jmpatrick]

It works, but ONLY if I select cells in col C. If I select cells in col G (for instance) it will add the . to the value in col G and col AS.

I need to ONLY affect col C and AS.

Thanks.

 

[Akuini]

It works, but ONLY if I select cells in col C. If I select cells in col G (for instance) it will add the . to the value in col G and col AS.

I need to ONLY affect col C and AS.

Thanks.

Ah, ok, try this:

    Dim c As Range
    For Each c In Selection
    If c.Value <> "" Then
        Cells(c.Row, "C") = Cells(c.Row, "C") & "."
        Cells(c.Row, "AS") = Cells(c.Row, "AS") & "."
    End If
    Next

 

[jmpatrick]

Ah, ok, try this:

    Dim c As Range
    For Each c In Selection
    If c.Value <> "" Then
        Cells(c.Row, "C") = Cells(c.Row, "C") & "."
        Cells(c.Row, "AS") = Cells(c.Row, "AS") & "."
    End If
    Next

I got there at the same time you did! Thanks for your help!

 

[Akuini]

You're welcome, glad to help & thanks for the feedback.

 

[jmpatrick]

Based on what you taught me I came up with this for an unconfirm. It works fine if run on cells in col C, I'm not sure how to get it to work when it's run from another column.

Sub MarkUnconfirmed()

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ActiveSheet.Unprotect

    Dim c As Range
    For Each c In Selection
    If Right(c.Value, 1) = "." Then
    c.Value = Left(c.Value, Len(c.Value) - 1)
    Cells(c.Row, "AS") = Cells(c.Row, "C")
    End If
    Next c
    
    'Protect Calendar
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub