Code works during step through, but not when I run it. Ugh

Pat_The_Bat

Board Regular
Joined
Jul 12, 2018
Messages
83
My Sub is putting the date stamp as intended, but then its as if it bails on everything after that point. It's supposed to format the two columns and then delete certain dates based which rows are headers.
Any thoughts why this is happening? Every time I run it, the formatting is never right, and the dates are in the cells where they are supposed to get removed. When I step through the code, it works as intended!!!



Code:
Sub DateStamping()
 'This is the Macro that the Time Stamp Button on the Publish Doc List Page operates
Application.ScreenUpdating = False


Dim NewDocs As String
Dim DocStmp As String
Dim NewDate As String
    'On Error GoTo Skiptohere2
        
        Sheets("Doc List").Activate
        
        With Sheets("Doc List")
         Dim LstRow As Integer
         LstRow = Range("F" & .Rows.Count).End(xlUp).Row
            Debug.Print LstRow
            
            NewDocs = .Range("F2:F499").SpecialCells(xlConstants).Address
            Debug.Print NewDocs
            
             DocStmp = .Range(NewDocs).Offset(, 21).Address
            
            Debug.Print DocStmp
               
            On Error GoTo Skiptohere2
                        
            NewDate = .Range(DocStmp).SpecialCells(xlBlanks).Address
            
             Debug.Print NewDate
                
            .Range(DocStmp).Value = "x"
            
               
                'using address from cprange we move selection left by 25 columns and timestamp
                
            .Range(NewDate).Offset(, -23).Value = Date
            
                Sheets("Doc List").Columns("D:E").NumberFormat = "m/d"
                Sheets("Doc List").Columns("D:E").HorizontalAlignment = xlCenter
                
   
           
            '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>DELETE
            
            Dim HDR1 As Range
            Dim HDRAK1 As Range
            Dim HDR2 As Range
            Dim HDRAK2 As Range
            Dim HDR3 As Range
            Dim HDRAK3 As Range
            Dim HDR4 As Range
            Dim HDRAK4 As Range
            Dim HDR5 As Range
            Dim HDRAK5 As Range
            
           
            
            Set HDRAK1 = Range("AK:AK").Find("Income")
            Debug.Print HDRAK1.Address
            Set HDR1 = HDRAK1.Offset(, -33)
            Debug.Print HDR1.Address
            HDR1.ClearContents
            
            Set HDRAK2 = Range("AK:AK").Find("Asset")
            Debug.Print HDRAK2.Address
            Set HDR2 = HDRAK2.Offset(, -33)
            Debug.Print HDR2.Address
            HDR2.ClearContents
            
            Set HDRAK3 = Range("AK:AK").Find("REO")
            Debug.Print HDRAK3.Address
            Set HDR3 = HDRAK3.Offset(, -33)
            Debug.Print HDR3.Address
            HDR3.ClearContents
            
            Set HDRAK4 = Range("AK:AK").Find("Credit")
            Debug.Print HDRAK4.Address
            Set HDR4 = HDRAK4.Offset(, -33)
            Debug.Print HDR4.Address
            HDR4.ClearContents
            
            Set HDRAK5 = Range("AK:AK").Find("Other")
            Debug.Print HDRAK5.Address
            Set HDR5 = HDRAK5.Offset(, -33)
            Debug.Print HDR5.Address
            HDR5.ClearContents
            End With
            
            '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>EndDELETE
            
            
                       GoTo SkiptoEnd
Skiptohere2:
MsgBox "Error"


SkiptoEnd:
            
            
        






End Sub
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
On a new sheet, this works for me without stepping through:
Code:
Sub Dates()

    Dim x       As Long
    Dim LR      As Long
    Dim arr     As Variant
    Dim r       As Range
    
    Application.ScreenUpdating = False
         
     With sheets("Doc List")
        x = .Cells(.Rows.Count, 6).End(xlUp).Row - 1
        With .Cells(2, 27).Resize(x).SpecialCells(xlCellTypeBlanks)
            .Offset(, -23).Value = Date
            .Value = "x"
        End With
        
        With .Cells(1, 4).Resize(, 2).EntireColumn
            .NumberFormat = "m/d"
            .HorizontalAlignment = xlCenter
        End With
        
        arr = arr("Income|Asset|REO|Credit|Other", "|")
        LR = .Range("AK" & .Rows.Count).End(xlUp).Row
        
        On Error Resume Next
        For x = LBound(arr) To UBound(arr)
            Set r = .Range("AK1").Resize(LR).Find(what:=CStr(arr(x)), LookIn:=xlValues, lookat:=xlWhole)
            If Not r Is Nothing Then
                r.Offset(, -33).ClearContents
                Set r = Nothing
            End If
        Next x
        On Error GoTo 0
    End With
                
    Application.ScreenUpdating = True
            
End Sub
 
Last edited:
Upvote 0
On a new sheet, this works for me without stepping through:
Code:
Sub Dates()

    Dim x       As Long
    Dim LR      As Long
    Dim arr     As Variant
    Dim r       As Range
    
    Application.ScreenUpdating = False
         
     With sheets("Doc List")
        x = .Cells(.Rows.Count, 6).End(xlUp).Row - 1
        With .Cells(2, 27).Resize(x).SpecialCells(xlCellTypeBlanks)
            .Offset(, -23).Value = Date
            .Value = "x"
        End With
        
        With .Cells(1, 4).Resize(, 2).EntireColumn
            .NumberFormat = "m/d"
            .HorizontalAlignment = xlCenter
        End With
        
        arr = arr("Income|Asset|REO|Credit|Other", "|")
        LR = .Range("AK" & .Rows.Count).End(xlUp).Row
        
        On Error Resume Next
        For x = LBound(arr) To UBound(arr)
            Set r = .Range("AK1").Resize(LR).Find(what:=CStr(arr(x)), LookIn:=xlValues, lookat:=xlWhole)
            If Not r Is Nothing Then
                r.Offset(, -33).ClearContents
                Set r = Nothing
            End If
        Next x
        On Error GoTo 0
    End With
                
    Application.ScreenUpdating = True
            
End Sub

I ran your code and I got the same result as my code. For some reason the code works up to the point of putting the date stamp in the cell, but then it does not change the formatting, and in my case it does not delete the contents of the specified cells (I don't think your code handled the deleting part, but you did have the formatting part in there so the fact that the formatting didn't work tells me that the code works up to the point where the time stamp happens, and then it stops working).

I've never been this stuck before. It works beautifully during step through. I had it working fine Sunday night. Now.... Kaput.
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,176
Members
453,021
Latest member
Justyna P

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