CODEWITHSUNDEEP
vbaexcel
Youiee
Youiee

Reputation: 43

Excel VBA Clearing range after copy and pasting range to another sheet

I'm using a code where the workbook detects if the current month has a sheet assigned to it or not and if not then the workbook will create a new sheet with the current month. After creating a new sheet it would copy and paste a certain range from the main sheet onto the new one. My problem is that after doing so I use a Range.Clear to clean the range that I copy pasted however it seems to be clearing it BEFORE copy-pasting.

Private Sub Worksheet_Change(ByVal Target As Range)
    nowMonth = Month(Now)
    nowYear = Year(Now)
    sheetNameStr = nowMonth & "," & nowYear

    sheetExists = False
    For Each Sheet In Worksheets
        If sheetNameStr = Sheet.Name Then
            sheetExists = True
        End If
    Next Sheet
    If sheetExists = False Then
        Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        ws.Name = sheetNameStr
        MsgBox ("New sheet named " & sheetNameStr & "was created")
    End If
    Sheets("Main").Activate

    Worksheets("Main").Range("A4:D300").Copy Worksheets(sheetNameStr).Range("A1")

    Worksheets("Main").Range("A6:D300").Clear
End Sub

Any help would be great thank you.

Upvotes: 2

Views: 2882

Answers (1)

Excelosaurus
Excelosaurus

Reputation: 2849

Here's what happens: the .Clear method causes Worksheet_Change to fire again; the Copy operation is repeated, clearing the destination; then the second Clear doesn't change anything, the source having been cleared already, and both Worksheet_Change procedures exit.

You have to surround your code with:

Application.EnableEvents = False

and 

Application.EnableEvents = True

Here's the updated code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim nowMonth As Integer
    Dim nowYear As Integer
    Dim sheetNameStr As String
    Dim oSheet As Excel.Worksheet
    Dim oNewSheet As Excel.Worksheet
    Dim sheetExists As Boolean

    On Error GoTo errHandler

    Application.EnableEvents = False

    nowMonth = Month(Now)
    nowYear = Year(Now)
    sheetNameStr = nowMonth & "," & nowYear

    sheetExists = False
    For Each oSheet In ThisWorkbook.Worksheets
        If sheetNameStr = oSheet.Name Then
            sheetExists = True
            Exit For 'Found, can exit the loop.
        End If
    Next
    If Not sheetExists Then
        Set oNewSheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Sheets.Count))
        oNewSheet.Name = sheetNameStr
        MsgBox "New sheet named " & sheetNameStr & " was created."
    End If

    Me.Activate
    Me.Range("A4:D300").Copy ThisWorkbook.Worksheets(sheetNameStr).Range("A1")
    Me.Range("A6:D300").Clear

Recover:
    On Error Resume Next
    Set oNewSheet = Nothing
    Set oSheet = Nothing
    Application.EnableEvents = True
    Exit Sub

errHandler:
    MsgBox Err.Description, vbExclamation + vbOKOnly, "Error"
    Resume Recover
End Sub

Notice that Worksheets is now qualified by ThisWorkbook; otherwise, your code would be referring to whichever workbook is active. Also, Sheets("Main") was replaced by Me as I assume your code is behind the Main worksheet and Me, from there, is the worksheet itself. Finally, whenever you turn EnableEvents off, you must provide adequate error handling to turn it back on in case of issues.

Edit

Here's the original code with just minimal changes to handle EnableEvents:

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo errHandler

    Application.ScreenUpdating = False

    nowMonth = Month(Now)
    nowYear = Year(Now)
    sheetNameStr = nowMonth & "," & nowYear

    sheetExists = False
    For Each Sheet In Worksheets
        If sheetNameStr = Sheet.Name Then
            sheetExists = True
            Exit For
        End If
    Next Sheet

    If Not sheetExists Then
        Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        ws.Name = sheetNameStr
        MsgBox ("New sheet named " & sheetNameStr & "was created")
    End If
    Sheets("Main").Activate

    Worksheets("Main").Range("A4:D300").Copy Worksheets(sheetNameStr).Range("A1")

    Worksheets("Main").Range("A6:D300").Clear

Recover:
    On Error Resume Next
    Application.ScreenUpdating = True
    Exit Sub

errHandler:
    MsgBox Err.Description, vbExclamation + vbOKOnly, "Error"
    Resume Recover
End Sub

Upvotes: 2

Related Questions