VBA Worksheet Change, loops and crashes Excel. How to work around?

[Weeble]

So I am trying to paste information into a sheet.
When information is pasted i want this code to run.

Private Sub Worksheet_Change(ByVal Target As Range)Dim emptyRow As Long


'Sätt fliken lager som aktiv
Worksheets("Uppföljning").Activate


'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("C:C")) + 1


On Error Resume Next
Cells(emptyRow, 6).Value = ThisWorkbook.Worksheets("Mailklipp").Range("A1").Value
Cells(emptyRow, 11).Value = ThisWorkbook.Worksheets("Mailklipp").Range("A2").Value
'Cells(emptyRow, 11).Value = ThisWorkbook.Worksheets("Mailklipp").Range("A3").Value
'Cells(emptyRow, 11).Value = ThisWorkbook.Worksheets("Mailklipp").Range("A4").Value
Cells(emptyRow, 5).Value = ThisWorkbook.Worksheets("Mailklipp").Range("A5").Value
Cells(emptyRow, 8).Value = ThisWorkbook.Worksheets("Mailklipp").Range("A6").Value
Cells(emptyRow, 7).Value = ThisWorkbook.Worksheets("Mailklipp").Range("A7").Value
'Cells(emptyRow, 11).Value = ThisWorkbook.Worksheets("Mailklipp").Range("A8").Value
Cells(emptyRow, 3).Value = ThisWorkbook.Worksheets("Mailklipp").Range("A14").Value
Cells(emptyRow, 4).Value = ThisWorkbook.Worksheets("Mailklipp").Range("A15").Value




ThisWorkbook.Worksheets("Mailklipp").Range("A1:A15").Clear
ThisWorkbook.Worksheets("Mailklipp").Range("A1").Value = "Klipp in här"
ThisWorkbook.Worksheets("Mailklipp").Range("A1").Interior.Color = RGB(67, 152, 61)


End Sub

But since they code is actualy changing in the workbook aswell, my guess is that it crashes it.
Is there any way to get around this?

 

[offthelip]

You need to turn of events at the start of your sub usng this code:

A[COLOR=#171717][FONT=SFMono-Regular]pplication.EnableEvents = [/FONT][/COLOR][COLOR=#07704A][FONT=SFMono-Regular]False[/FONT][/COLOR]

then at the end ofthe code you need to turn them on again with this code:

[COLOR=#171717][FONT=SFMono-Regular]Application.EnableEvents = [/FONT][/COLOR][FONT=SFMono-Regular][COLOR=#07704a]True[/COLOR][/FONT]

what is happening is that when you write to cells(emptyrow,6) ( and all the subsequent lines) , it triggers the worksheet change event again even though you are in the middle of it, so you get an endless loop

 

[Weeble]

Tried this, but what happens is that it writes the pasted lines in sheet("mailklipp").
Looks like the EnableEvents terminates the

[COLOR=#333333]Worksheets("Uppföljning").Activate[/COLOR]

function.
I tried changing my code to this

Private Sub Worksheet_Change(ByVal Target As Range)Dim emptyRow As Long


Application.EnableEvents = False


'Sätt fliken lager som aktiv
Worksheets("Uppföljning").Activate


'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("C:C")) + 1


On Error Resume Next
ThisWorkbook.Worksheets("Uppföljning").Cells(emptyRow, 6).Value = ThisWorkbook.Worksheets("Mailklipp").Range("A1").Value
ThisWorkbook.Worksheets("Uppföljning").Cells(emptyRow, 11).Value = ThisWorkbook.Worksheets("Mailklipp").Range("A2").Value
'Cells(emptyRow, 11).Value = ThisWorkbook.Worksheets("Mailklipp").Range("A3").Value
'Cells(emptyRow, 11).Value = ThisWorkbook.Worksheets("Mailklipp").Range("A4").Value
ThisWorkbook.Worksheets("Uppföljning").Cells(emptyRow, 5).Value = ThisWorkbook.Worksheets("Mailklipp").Range("A5").Value
ThisWorkbook.Worksheets("Uppföljning").Cells(emptyRow, 8).Value = ThisWorkbook.Worksheets("Mailklipp").Range("A6").Value
ThisWorkbook.Worksheets("Uppföljning").Cells(emptyRow, 7).Value = ThisWorkbook.Worksheets("Mailklipp").Range("A7").Value
'Cells(emptyRow, 11).Value = ThisWorkbook.Worksheets("Mailklipp").Range("A8").Value
ThisWorkbook.Worksheets("Uppföljning").Cells(emptyRow, 3).Value = ThisWorkbook.Worksheets("Mailklipp").Range("A14").Value
ThisWorkbook.Worksheets("Uppföljning").Cells(emptyRow, 4).Value = ThisWorkbook.Worksheets("Mailklipp").Range("A15").Value




ThisWorkbook.Worksheets("Mailklipp").Range("A1:A15").Clear
ThisWorkbook.Worksheets("Mailklipp").Range("A1").Value = "Klipp in här"
ThisWorkbook.Worksheets("Mailklipp").Range("A1").Interior.Color = RGB(67, 152, 61)
Application.EnableEvents = True
End Sub

I now get the pasted values in the right Worksheet, but it does not run my

[COLOR=#333333]emptyRow = WorksheetFunction.CountA(Range("C:C")) + 1[/COLOR]

It paste eveything on First row.

 

[Fluff]

Which sheet is that code in?

 

[Weeble]

It's in sheet "Mailklipp"

 

[Fluff]

In that case try

Private Sub Worksheet_Change(ByVal Target As Range)
Dim emptyRow As Long


'Sätt fliken lager som aktiv
With Worksheets("Uppföljning")
   
   
   'Determine emptyRow
   emptyRow = WorksheetFunction.CountA(.Range("C:C")) + 1
   
   
   .Cells(emptyRow, 6).Value = Me.Range("A1").Value
   .Cells(emptyRow, 11).Value = Me.Range("A2").Value
   '.Cells(emptyRow, 11).Value = me.Range("A3").Value
   '.Cells(emptyRow, 11).Value = me.Range("A4").Value
   .Cells(emptyRow, 5).Value = Me.Range("A5").Value
   .Cells(emptyRow, 8).Value = Me.Range("A6").Value
   .Cells(emptyRow, 7).Value = Me.Range("A7").Value
   '.Cells(emptyRow, 11).Value = me.Range("A8").Value
   .Cells(emptyRow, 3).Value = Me.Range("A14").Value
   .Cells(emptyRow, 4).Value = Me.Range("A15").Value
End With


Application.EnableEvents = False
Me.Range("A1:A15").Clear
Me.Range("A1").Value = "Klipp in här"
Me.Range("A1").Interior.Color = RGB(67, 152, 61)
Application.EnableEvents = True

End Sub

 

[Weeble]

That fixed it!
I'm gonna read up on Me.
Thank you fluff

 

[Fluff]

You're welcome & thanks for the feedback.

In this context Me is the sheet that contains the code.