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]

Can you explain what you're trying to do?

 

[jmpatrick]

Can you explain what you're trying to do?

Sure.

The first macro adds a . (period) to whatever value is in col C and col AS of the selected row(s) if one doesn't already exist.

The second macro removes any . that appears in col C and col AS of the selected row(s).

 

[Akuini]

The second macro removes any . that appears in col C and col AS of the selected row(s).

Try:

Sub MarkUnconfirmed()

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

    Dim c As Range
    Dim tx As String
    For Each c In Selection
        tx = Cells(c.Row, "C").Value
        If Right(tx, 1) = "." Then
            Cells(c.Row, "C").Value = Left(tx, Len(tx) - 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

 

[jmpatrick]

Try:

Sub MarkUnconfirmed()

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

    Dim c As Range
    Dim tx As String
    For Each c In Selection
        tx = Cells(c.Row, "C").Value
        If Right(tx, 1) = "." Then
            Cells(c.Row, "C").Value = Left(tx, Len(tx) - 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

Works very nicely! You've taught me a bunch today. Thanks again.

 

[Akuini]

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