Manually run VBA on specific cell range

[Lord_B]

Hi,

Firstly thanks for looking

I have a spreadsheet were I need to reset a range of cells, I have recorded a macro (see below) which will reset the range. There are 1100 ranges in total.

What I am asking is, is there a way to click on a cell, any cell and run the below code. I know the code will need to be manipulated but I have no idea how. I have Googled for an answer but I'm more confused then when I started looking.

Sub resetRange()
'
' resetRange Macro
'
' Keyboard Shortcut: Ctrl+o
'
    Range("AJZ135").Select
    Selection.ClearContents
    Range("AKA135").Select
    Selection.ClearContents
    Range("AKB135").Select
    Selection.ClearContents
    Range("AKC135").Select
    Selection.ClearContents
    Range("AKD135").Select
    Selection.ClearContents
    Range("AKE135").Select
    Selection.ClearContents
    Range("AKF135").Select
    Selection.ClearContents
    Range("AKG135").Select
    Selection.ClearContents
    Range("AKH135").Select
    Selection.ClearContents
    Range("AKI135").Select
    Selection.ClearContents
    Range("AKJ135").Select
    Selection.ClearContents
    Range("AKK135").Select
    Selection.ClearContents
    Range("AKL135").Select
    Selection.ClearContents
    Range("AKM135").Select
    Selection.ClearContents
    Range("AJZ136").Select
    ActiveCell.FormulaR1C1 = "12:00:00 AM"
    Range("AKA136").Select
    ActiveCell.FormulaR1C1 = "12:00:00 AM"
    Range("AKB136").Select
    ActiveCell.FormulaR1C1 = "12:00:00 AM"
    Range("AKC136").Select
    ActiveCell.FormulaR1C1 = "12:00:00 AM"
    Range("AKD136").Select
    ActiveCell.FormulaR1C1 = "12:00:00 AM"
    Range("AKE136").Select
    ActiveCell.FormulaR1C1 = "12:00:00 AM"
    Range("AKF136").Select
    ActiveCell.FormulaR1C1 = "12:00:00 AM"
    Range("AKG136").Select
    ActiveCell.FormulaR1C1 = "12:00:00 AM"
    Range("AKH136").Select
    ActiveCell.FormulaR1C1 = "12:00:00 AM"
    Range("AKI136").Select
    ActiveCell.FormulaR1C1 = "12:00:00 AM"
    Range("AKJ136").Select
    ActiveCell.FormulaR1C1 = "12:00:00 AM"
    Range("AKK136").Select
    ActiveCell.FormulaR1C1 = "12:00:00 AM"
    Range("AKL136").Select
    ActiveCell.FormulaR1C1 = "12:00:00 AM"
    Range("AKM136").Select
    ActiveCell.FormulaR1C1 = "12:00:00 AM"
    Range("AKA137").Select
    ActiveCell.FormulaR1C1 = "12:00:00 AM"
    Range("AKC137").Select
    ActiveCell.FormulaR1C1 = "12:00:00 AM"
    Range("AKE137").Select
    ActiveCell.FormulaR1C1 = "12:00:00 AM"
    Range("AKG137").Select
    ActiveCell.FormulaR1C1 = "12:00:00 AM"
    Range("AKI137").Select
    ActiveCell.FormulaR1C1 = "12:00:00 AM"
    Range("AKK137").Select
    ActiveCell.FormulaR1C1 = "12:00:00 AM"
    Range("AKM137").Select
    ActiveCell.FormulaR1C1 = "12:00:00 AM"
    Range("AKM3").Select
End Sub

Thank you in advance for helping/looking,

Ben

 

[Lord_B]

When writing code for a number of ranges like this we would not write 500 lines of code or more.
We look for a trend or some rational reasoning why such ranges are chosen.

So in your example why did you start with Row 135 and 136
And why did you start with column 958 and will it always start at 958 and end at 958 +18

And to use active cell would mean you might need to run the code 1100 times depending on where the active cell is.

Sorry, I should of started with the beginning rage of B7:O9, the last column range is AWX - AXK. There is data in between the ranges.

What 'JackDanIce' has shown works apart from line 3 of my table, were it needs to change every second cell in the range.

 

[JackDanIce]

Try:

Sub ClearRanges()

    Dim r   As Range
    
    Dim LR  As Long
    Dim LC  As Long
    
    Dim x   As Long
    Dim y   As Long
    
    Application.ScreenUpdating = False
    
    LR = Cells(Rows.Count, 2).End(xlUp).Row
    LC = Cells(7, Columns.Count).End(xlToLeft).Column
    
    For x = 7 To LR Step 33
        For y = 2 To LC Step 25
            With Cells(x, y).Resize(, 14)
                .ClearContents
                .Offset(1).Value = "12:00:00 AM"
                For Each r In .Offset(2)
                    If Not r.HasFormula Then r.Value = "12:00:00 AM"
                Next r
            End With
        Next y
    Next x
    
    Application.ScreenUpdating = True
    
End Sub

 

[Lord_B]

Based on post #7 , save a copy of your workbook, then try

Sub ClearRanges()
    
    Dim LR  As Long
    Dim LC  As Long
    
    Dim x   As Long
    Dim y   As Long
    
    Application.ScreenUpdating = False
    
    LR = Cells(Rows.Count, 2).End(xlUp).Row
    LC = Cells(7, Columns.Count).End(xlToLeft).Column
    
    For x = 7 To LR Step 33
        For y = 2 To LC Step 25
            With Cells(x, y).Resize(, 14)
                .ClearContents
                .Offset(1).Value = "12:00:00 AM"
            End With
        Next y
    Next x
    
    Application.ScreenUpdating = True
    
End Sub

Thanks for the above it works great apart from the third line of the table in post 3 where i need to reformat every 2nd cell. again, thanks for the above

 

[Lord_B]

The code above reformat's the 3rd line in total taking out the formulas in the 1st cell

 

[DataBlake]

B7:O9 B39:O41 B71:O73 B103:O105 B135:O137 B167:O169 B199:O201 B231:O233 B263:O265 B295:O297 B327:O329 B359:O361 B391:O393 B423:O425 B455:O457 B487:O489 B519:O521 B551:O553 B583:O585 B615:O617

Z7:AM9 Z39:AM41 Z71:AM73 Z103:AM105 Z135:AM137 Z167:AM169 Z199:AM201 Z231:AM233 Z263:AM265 Z295:AM297 Z327:AM329 Z359:AM361 Z391:AM393 Z423:AM425 Z455:AM457 Z487:AM489 Z519:AM521 Z551:AM553 Z583:AM585 Z615:AM617

AX7:BK9 AX39:BK41 AX71:BK73 AX103:BK105 AX135:BK137 AX167:BK169 AX199:BK201 AX231:BK233 AX263:BK265 AX295:BK297 AX327:BK329 AX359:BK361 AX391:BK393 AX423:BK425 AX455:BK457 AX487:BK489 AX519:BK521 AX551:BK553 AX583:BK585 AX615:BK617

BV7:CI9 BV39:CI41 BV71:CI73 BV103:CI105 BV135:CI137 BV167:CI169 BV199:CI201 BV231:CI233 BV263:CI265 BV295:CI297 BV327:CI329 BV359:CI361 BV391:CI393 BV423:CI425 BV455:CI457 BV487:CI489 BV519:CI521 BV551:CI553 BV583:CI585 BV615:CI617

CT7:DG9 CT39:DG41 CT71:DG73 CT103:DG105 CT135:DG137 CT167:DG169 CT199:DG201 CT231:DG233 CT263:DG265 CT295:DG297 CT327:DG329 CT359:DG361 CT391:DG393 CT423:DG425 CT455:DG457 CT487:DG489 CT519:DG521 CT551:DG553 CT583:DG585 CT615:DG617

DR7:EE9 DR39:EE41 DR71:EE73 DR103:EE105 DR135:EE137 DR167:EE169 DR199:EE201 DR231:EE233 DR263:EE265 DR295:EE297 DR327:EE329 DR359:EE361 DR391:EE393 DR423:EE425 DR455:EE457 DR487:EE489 DR519:EE521 DR551:EE553 DR583:EE585 DR615:EE617

EP7:FC9 EP39:FC41 EP71:FC73 EP103:FC105 EP135:FC137 EP167:FC169 EP199:FC201 EP231:FC233 EP263:FC265 EP295:FC297 EP327:FC329 EP359:FC361 EP391:FC393 EP423:FC425 EP455:FC457 EP487:FC489 EP519:FC521 EP551:FC553 EP583:FC585 EP615:FC617

FN7:GA9 FN39:GA41 FN71:GA73 FN103:GA105 FN135:GA137 FN167:GA169 FN199:GA201 FN231:GA233 FN263:GA265 FN295:GA297 FN327:GA329 FN359:GA361 FN391:GA393 FN423:GA425 FN455:GA457 FN487:GA489 FN519:GA521 FN551:GA553 FN583:GA585 FN615:GA617

GL7:GY9 GL39:GY41 GL71:GY73 GL103:GY105 GL135:GY137 GL167:GY169 GL199:GY201 GL231:GY233 GL263:GY265 GL295:GY297 GL327:GY329 GL359:GY361 GL391:GY393 GL423:GY425 GL455:GY457 GL487:GY489 GL519:GY521 GL551:GY553 GL583:GY585 GL615:GY617

HJ7:HW9 HJ39:HW41 HJ71:HW73 HJ103:HW105 HJ135:HW137 HJ167:HW169 HJ199:HW201 HJ231:HW233 HJ263:HW265 HJ295:HW297 HJ327:HW329 HJ359:HW361 HJ391:HW393 HJ423:HW425 HJ455:HW457 HJ487:HW489 HJ519:HW521 HJ551:HW553 HJ583:HW585 HJ615:HW617

<tbody>
</tbody>

is there a pattern to these ranges?
you can upload to dropbox and link me

Edit: nvm it looks like a solution was found other than formatting

 

[JackDanIce]

Try:

Sub ClearRanges()

    Dim r   As Range
    
    Dim LR  As Long
    Dim LC  As Long
    
    Dim x   As Long
    Dim y   As Long
    Dim z   As Long
    
    Application.ScreenUpdating = False
    
    LR = Cells(Rows.Count, 2).End(xlUp).Row
    LC = Cells(7, Columns.Count).End(xlToLeft).Column
    
    For x = 7 To LR Step 33
        For y = 2 To LC Step 25
            With Cells(x, y).Resize(, 14)
                .ClearContents
                .Offset(1).Value = "12:00:00 AM"
                Set r = .Offset(2)
            End With
            For z = 2 To 14 Step 2
                r.Cells(1, z).Value = "12:00:00 AM"
            Next z
        Next y
    Next x
    
    Application.ScreenUpdating = True
    
End Sub

 

[Lord_B]

JackDanIce - you have made a grown man cry, thank you so much! works perfectly.

 

[JackDanIce]

You're welcome, glad it's resolved