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

Question

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.

Answer 1

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