VBA Select last empty cell in Month column using today's date and paste data

Question

I'm trying to use VBA script to trigger when checkbox is checked that copies data from one particular cell and pastes in the last empty cell of Month column using Today's date. Here is my code thus far, and I've tested the check box triggering the copy and paste function. What I can't figure out is finding the correct column using today's date and selecting the next empty cell in that column. My columns are labeled on a second sheet using long month names (text data).

Sub CheckBoxUpdated()
Dim Mnth As String
Dim fndrng
Dim cb As CheckBox


Mnth = MonthName(Month(Date))
With Sheet2 'has to be 'with' something to work correctly
    Set fndrng = Cells.Find(What:=Mnth, After:=A1, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=True)
End With

    On Error Resume Next
    Set cb = ActiveSheet.DrawingObjects(Application.Caller)
    On Error GoTo 0

    If Not cb Is Nothing Then
        If cb.Value = 1 Then
            Sheets("Sheet1").Range(cb.LinkedCell).Offset(0, -4).Copy
            Sheets("Sheet2").Activate
            fndrng.Offset(4, 0).Select
            ActiveSheet.Paste
        End If
    End If

End Sub

Any help is much appreciated, thanks!!!!

score 0 · Answer 1 · edited May 23 '17 at 11:58

Two things I noticed immediately.

Within your first With...End With statement, the Set fndrng = Cells.Find ... is missing the prefix period that assigns the worksheet parent from the With statement. Should be Set fndrng = .Cells.Find...
The close of the With Sheet2 could be extended down to encompass much more of the code, releasing you from dependence on things like ActiveSheet and Select.

Consider this rewrite.

Sub CheckBoxUpdated()
    Dim Mnth As String, fndrng as range, cb As CheckBox

    On Error Resume Next

    Mnth = MonthName(Month(Date))

    With Sheet2 'has to be 'with' something to work correctly
        Set fndrng = Cells.Find(What:=Mnth, After:=A1, LookAt:=xlPart, _
                                SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                MatchCase:=True)

        Set cb = .DrawingObjects(Application.Caller)
        On Error GoTo 0

        If Not cb Is Nothing Then
            If cb.Value = 1 Then
                Sheets("Sheet1").Range(cb.LinkedCell).Offset(0, -4).Copy _
                    Destination:=fndrng.Offset(4, 0)
            End If
        End If

    End With

End Sub

I changed your method of Copy & Paste to a more direct method in keeping with the expansion of the With/End With statement.

See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.

This is a great help. It really cleans up my code. That article is very informative as well. Now I'm getting a run-time error 91 and I'm seeing that fndrng is not being set, so when it gets down to the "IF" statement, the value of fndrng is "Nothing". So that "Find" loop is not catching the month in the first row of sheet2. — Matthew Wyenandt, Jun 04 '15 at 14:08
I had been wondering about `After:=A1` but couldn't check everything. Try `After:=.Range("A1")` — , Jun 04 '15 at 14:18
Okay, that helped immensely, I was getting run-time error, but it ended up being a locked cell that was giving me problems. Now I need to figure out how to find the first blank cell in the fndrng column and paste it there. — Matthew Wyenandt, Jun 04 '15 at 16:30
If fndrng has been found correctly then fndrng.column is the column. The first blank cell should be .cells(1, fndrng.colum).end(xlDown).offset(1, 0). — , Jun 04 '15 at 20:52

VBA Select last empty cell in Month column using today's date and paste data

1 Answers1