Excel Adds Code after "End Sub" when tied to Keyboard Shortcut? 2

[kjv1611]

Microsoft Office Excel 2007 running on Windows XP Pro

One of my coworkers, yesterday, was having issues with the fill-down routine in Excel. She said that prior to that day, she could make the fill method fill a series of dates, where it changed by month in decending order. So if she started on 12/5/2010, the next cell below would be 11/5/2010, then 10/5/2010 in the next one, and so on.

She said she ALWAYS did this for 12 months - one year - in the particular process. So, I built a VBA Subroutine that would take the actively selected cell's date value, and copy it down 12 rows, just the way she wanted. It works great, EXCEPT...

We tied the macro to the keyboard shortcut <Ctrl>+<Q>, for ease of access in running it. Well, if she then pressed <Ctrl>+<Q>, Excel would immediately paste some misplaced (no idea where it comes from) code after End Sub in the module, and then errors out, saying, "Only Comments can be included after the End Sub line" - paraphrased.

I haven't yet tested on my machine. She wasn't concerned about it, b/c we put a button in her Quick Access Toolbar, and it works with that. We removed the shortcut assignment, and all works fine.

I may try to test it on my machine today just to see, but it just sounds really really odd to me, and I've not the foggiest idea as to what caused it.

For reference, here's the code:

Option Explicit

Private Sub MonthReverseYear()
On Error GoTo ErrHandle
[GREEN]'.. to copy and reverse the month from the selected date down 12 cells... for one year
'.. to give easy method vs the Autofill, since it seems to have issues.
    
'Create Variables[/GREEN]
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim x As Integer
    Dim intRow As Integer 'Row Number
    Dim intCount As Integer 'counter
    
IsADate:
        Set wb = ActiveWorkbook
        Set ws = wb.ActiveSheet
        
        x = Month(ActiveCell.Value)
        
[GREEN]'Check to be sure an actual date value'd cell has been selected.[/GREEN]
    If IsDate(ActiveCell.Value) Then
        For intCount = 1 To 12
            x = Month(Trim(ActiveCell.Value))
            intRow = ActiveCell.Row
            If x = 1 Then
                ws.Cells(intRow + 1, ActiveCell.Column).Formula = _
                    "12/" & _
                    Day(Trim(ActiveCell.Value)) & "/" & _
                    Year(Trim(ActiveCell.Value)) - 1
                ws.Cells(intRow + 1, ActiveCell.Column).Select
            Else
                ws.Cells(intRow + 1, ActiveCell.Column).Formula = _
                    Month(Trim(ActiveCell.Value)) - 1 & "/" & _
                    Day(Trim(ActiveCell.Value)) & "/" & _
                    Year(Trim(ActiveCell.Value))
                ws.Cells(intRow + 1, ActiveCell.Column).Select
            End If
        Next intCount
    Else
        If Left(ActiveCell.Formula, 1) = "'" Then
[GREEN]'Attempt some corection if possible[/GREEN]
            ActiveCell.Formula = Replace(ActiveCell.Formula, "'", "")
            ActiveCell.Formula = Right(ActiveCell.Formula, Len(ActiveCell.Formula) - 1)
            ActiveCell.Activate
            ws.Cells(ActiveCell.Row, ActiveCell.Column + 1).Activate
            ws.Cells(ActiveCell.Row, ActiveCell.Column - 1).Activate
            GoTo IsADate
        Else
        
[GREEN]'If no real date value selected, give an error message, and do not proceed with the above code.
'Also give ideas as to how to fix the issue if it seems like it should have worked.[/GREEN]
            MsgBox "Not a Date Value!" & Chr(10) & Chr(10) & _
                "Please select a Cell that has a date value." & Chr(13) & _
                "If you believe you receive this message in error, please check the cell's number format: " & _
                "if the cell's number format is set to TEXT, then this code may not propertly recognize the date value. " _
                , vbCritical, "Not a Date!"
        End If
    End If

ExitSub:
    Set wb = Nothing
    Set ws = Nothing
    x = 0
    intRow = 0
    intCount = 0

    Exit Sub
    
ErrHandle:
[GREEN]'Record what the error was for future debugging reference, if needed.[/GREEN]
    Debug.Print "--------------------------------------------"
    Debug.Print "------New Error------"
    Debug.Print "------MonthReverseYear------"""
    Debug.Print "When: " & Now()
    Debug.Print "Who was Running it: " & Environ("User")
    Debug.Print "Error Specifics: " & Err.Number & " " & Err.Description
    Debug.Print "--------------------------------------------"
    GoTo ExitSub
    
End Sub

This isn't the end of the world, as it works fine w/o the keyboard shortcut.

This morning, I did a test run on my local machine. Same code, different workbook/worksheet, different computer, different shortut. I already have something assigned to Ctrl+Q, so I set it to Ctrl+M on my machine, ran a few times, not a bit of trouble. Oh, same OS, same version of office, etc.

If anybody has any clues, that'd be great. If not, it's not a big deal, but it'd be great to at least find out WHY it is happening.

 

[Andrzejek]

But in the code you provided you just have one End Sub, it is at the end of your code, there are no lines of code after that, not even comments....

Have fun.

---- Andy

 

[kjv1611]

Yes, I didn't copy down the code that was added by Excel. It did it every time the shortcut was run (there was no previous command of any sort tied to the shortcut).

Every time we saw the code, we simply deleted it. Looking back, I wish I had copied it down.

Well, this isn't a big issue, really. I am pretty sure it's something on the specific machine, as I could not duplicate it on mine.

Now, I have a different issue I'm trying to sort out, and I'll start a new thread if I can't get it sorted out. Basically, so far, I've come across one date entered (6/30/2007) that ends up erroring out after it has copied down 4 cells.. not sure just yet what that is.

Well, please excuse my meanderings this morning.

 

[SkipVought]

ne date entered (6/30/2007) that ends up erroring out after it has copied down 4 cells

[tt]
5
4
3
2 -- FEBRUARY has no day 30!!!
[/tt]


Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[kjv1611]

Yeah, thanks, Skip! I just now figured that out - well, about 3 minutes ago.

For the particular purpose of this code, the day doesn't matter, I was just told, so I'm going to change the code to just put a 1 for the day of each month - they just need the month and year value to be correct.

Shew!

On the other issue (Excel randomly adding code) - not sure I'll ever get that one figured out.

 

[kjv1611]

Oh, and I'd imagine I could have designed the code better overall, but it works - now that I corrected the day.

Also, I did take out one additional little spot in the code that was unnecessary. So, just for reference, the fixed code - regarding the invalid date - is here:

Option Explicit

Sub MonthReverseYear()
On Error GoTo ErrHandle
'.. to copy and reverse the month from the selected date down 11 cells... for one year (12 months, total)
'.. to give easy method vs the Autofill, since it seems to have issues.
    
'Create Variables
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim x As Integer
    Dim intRow As Integer 'Row Number
    Dim intCount As Integer 'counter
    
IsADate:
        Set wb = ActiveWorkbook
        Set ws = wb.ActiveSheet
        
'Check to be sure an actual date value'd cell has been selected.
    If IsDate(ActiveCell.Value) Then
        For intCount = 1 To 11
            x = Month(Trim(ActiveCell.Value))
            intRow = ActiveCell.Row
            If x = 1 Then 'January
                ws.Cells(intRow + 1, ActiveCell.Column).Formula = _
                    "12/1/" & _
                    Year(Trim(ActiveCell.Value)) - 1
                ws.Cells(intRow + 1, ActiveCell.Column).Select
            Else
                ws.Cells(intRow + 1, ActiveCell.Column).Formula = _
                    Month(Trim(ActiveCell.Value)) - 1 & "/1/" & _
                    Year(Trim(ActiveCell.Value))
                ws.Cells(intRow + 1, ActiveCell.Column).Select
            End If
        Next intCount
    Else
        If Left(ActiveCell.Formula, 1) = "'" Then
'Attempt some corection if possible
            ActiveCell.Formula = Replace(Trim(ActiveCell.Formula), "'", "")
            ActiveCell.Formula = Right(Trim(ActiveCell.Formula), Len(Trim(ActiveCell.Formula)) - 1)
            ActiveCell.Activate
            ws.Cells(ActiveCell.Row, ActiveCell.Column + 1).Activate
            ws.Cells(ActiveCell.Row, ActiveCell.Column - 1).Activate
            GoTo IsADate
        Else
        
'If no real date value selected, give an error message, and do not proceed with the above code.
'Also give ideas as to how to fix the issue if it seems like it should have worked.
            MsgBox "Not a Date Value!" & Chr(10) & Chr(10) & _
                "Please select a Cell that has a date value." & Chr(13) & _
                "If you believe you receive this message in error, please check the cell's number format: " & _
                "if the cell's number format is set to TEXT, then this code may not propertly recognize the date value. " _
                , vbCritical, "Not a Date!"
        End If
    End If

ExitSub:
    Set wb = Nothing
    Set ws = Nothing
    x = 0
    intRow = 0
    intCount = 0

    Exit Sub
    
ErrHandle:
'Record what the error was for future debugging reference, if needed.
    Debug.Print "--------------------------------------------"
    Debug.Print "------New Error------"
    Debug.Print "------MonthReverseYear------"""
    Debug.Print "When: " & Now()
    Debug.Print "Who was Running it: " & Environ("UserName")
    Debug.Print "Error Specifics: " & Err.Number & " " & Err.Description
    Debug.Print "--------------------------------------------"
    GoTo ExitSub
    
End Sub

 

[SkipVought]

This is all you need to get ANY date minus 4 months, first-of-the-month...

    If IsDate(ActiveCell.Value) Then
       'decriment by 4 months
       with ActiveCell
         .Value = DateSerial(Year(.value), Month(.value)-4,1)
       end with
    end if

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[kjv1611]

I figured there was a Date function I was forgetting. I'll take a shot at changing to using that, just to try it out. Thanks for the tip, Skip.

 

[DaveInIowa]

She said that prior to that day, she could make the fill method fill a series of dates, where it changed by month in decending order.

If she selected only a single date, Excel has no way of making any determination as to how to increment (or decrement) subsequent cells so by default it would increment the filled cells by one day. If I'm off-base and there is an override to this behavior, someone please let me know. Until then, don't believe everything your co-workers tell you.

Public Sub Backfill12Months()
    Dim rg2Months As Range

    Set rg2Months = ActiveCell.Resize(2)
    If (IsDate(rg2Months(1)) And IsEmpty(rg2Months(2))) Then
        rg2Months(2) = DateAdd("m", -1#, CDate(rg2Months(1)))
        rg2Months.AutoFill ActiveCell.Resize(12)
    End If

End Sub

 

[kjv1611]

DaveInIowa,

It's true you can't believe everything everyone tells you. However, in this case, the person had no reason to lie, and I have no reason to NOT believe her. It's possible she did something on accident somewhere, but she's been doing that same task for quite some time. Oh, she wasn't selecting a single cell to do this, but rather a few cells in a column. I just fixed the posted code so she could just type one date, select it, and click a button.

I'll try the last example sometime, to see what difference it gives,... If I can get the time.

The current method is working - the original one I posted. It happens instantly, so I don't see any real need to change it just now. Regardless, I'm always curious as to ways to build better code. Also, I do like that you've got a check built-in to check for blank cells underneath.

I did test the code you wrote, and really do like the way it runs. I may suggest replacing what I typed up earlier with that, or at least including it. I like the way it keeps the date if it's a real date, or else fixes it to the last date of the month if it's an impossible date.