Loop that only works on specific columns?

jmpatrick

Active Member
Joined
Aug 17, 2016
Messages
482
Office Version
  1. 365
Platform
  1. Windows
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:

VBA Code:
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
 
Can you explain what you're trying to do?
 
Upvote 0

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
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).
 
Upvote 0
The second macro removes any . that appears in col C and col AS of the selected row(s).
Try:
VBA Code:
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
 
Upvote 1
Solution
Try:
VBA Code:
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.
 
Upvote 0
You're welcome, glad to help & thanks for the feedback.:)
 
Upvote 0

Forum statistics

Threads
1,223,214
Messages
6,170,774
Members
452,353
Latest member
strainu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top