Macro works fine on a button but hangs on Worksheet_Activate

[SBNUT]

I have created a macro that will copy data from one sheet and post to another sheet. Then sort the data, and create header rows and spaces. If I assign the macro to a button on the worksheet where I want the data, everything works fine. I would like this data to refresh everything I go into that sheet without having to hit a button. So I copied the code from the macro and pasted it into a module where I have a Worksheet_Activate that calls the code. The same code that works with the button is not working with the Worksheet_Activate. I have looked at the code and can not see the problem. I have attached the worksheet with both the button and the code to activate with the sheet is called. (The Worksheet_Activate is currently commented out so you can try the button to see what the data should look like) The code is in Sheet6 (Construction)

How the workbook works. The first sheet is the estimate sheet. We pick and choose items in this sheet that is needed for the job. Then we go into the "JobList" sheet. This only shows the values that were selected in the estimate tab. This does have a Worksheet_activate that produces this list and that is working correctly. The sheet that is not working correctly is the "Construction" tab. This should take the values in the "Job List" tab, copy it to the new sheet, sort it by cost type, and but some headers and blank rows in the sheet. This works correctly if you hit the button on the top right of the screen. However, if you go into the code and un-comment the Worksheet_Activate, the code does not work?

Private Sub Worksheet_Activate()
Call Construction1
End Sub

Sub Construction1()
'
'
Rows("8:685").Select
Selection.Delete Shift:=xlUp
Range("D14").Select
Sheets("Job List").Select
Sheets("Job List").Range("A8:J8").Select
Sheets("Job List").Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Construction").Select
Range("A8").Select
ActiveSheet.Paste
Range("A7:J7").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Construction").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Construction").Sort.SortFields.Add2 Key:=Range( _
"F8:F500"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Construction").Sort
.SetRange Range("A7:J500")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Dim i As Long

For i = Range("F" & Rows.Count).End(xlUp).Row To 9 Step -1
If Cells(i, 6) <> Cells(i - 1, 6) Then
Rows(i).Resize(3).Insert
Rows(7).Copy Rows(i + 2)
End If
Next i

End Sub

 

[SBNUT]

It still stops on the same code. Would it be helpful if I sent you a copy of the workbook? Can't figure out how to attach to this thread, but could email it to you.

 

[SQUIDD]

did you notice and try post 20.

i have created the same envirmomet with sheet names and data etc.

mine works.

Dave

 

[SBNUT]

OK thanks, I'll keep plugging away and see if I can figure out why mine isn't working.

 

[SBNUT]

Can't figure it out why the VBA stops on this line. I guess I'll just leave the button on the screen and make my employee's run the macro each time they go to that sheet and hope they don't forget. Thanks for the help.

 

[SQUIDD]

So did you try post 20?

placing code in standard module, the calling the code from worksheet activation?

what is the error message ?

 

[SBNUT]

Not sure what you mean by post 20. The error is a run-time error 1004

Here is the actual code that I typed in. The yellow is where it stopped

 

[SQUIDD]

REPLACE IT WITH THIS

LR = Cells(Rows.Count, 1).End(xlUp).Row

Post 20, i meant post number 20 of our convo

dave

 

[SBNUT]

closer.... It ran but it only copied Lines 7 and 8 from sheet "Job List" to sheet "Construction". See the screen shots below/

This is what sheet "Job List" looks like.

Here is sheet "Construction" After the copy and paste.

I really think it has to do with the formatting of lines 1 - 7 on sheet "Job List" but I could be wrong.

 

[SQUIDD]

if you can find a free site to upload you file to.

then post the link, i would be very intrested to have a look

Dave

 

[SQUIDD]

Hi

ok, had another idea

you original code since it worked for you

but a couple of changes.

put that in your sheet module

im sure this will now probably work, although i would be intrrested still to figure out what was going wrong

Private Sub Worksheet_Activate()
Application.EnableEvents = False
Rows("8:685").Select
Selection.Delete Shift:=xlUp
Range("D14").Select
Sheets("Job List").Select
Sheets("Job List").Range("A8:J8").Select
Sheets("Job List").Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Construction").Select
Range("A8").Select
ActiveSheet.Paste
Range("A7:J7").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Construction").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Construction").Sort.SortFields.Add2 Key:=Range( _
"F8:F500"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Construction").Sort
.SetRange Range("A7:J500")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Dim i As Long

For i = Range("F" & Rows.Count).End(xlUp).Row To 9 Step -1
If Cells(i, 6) <> Cells(i - 1, 6) Then
Rows(i).Resize(3).Insert
Rows(7).Copy Rows(i + 2)
End If
Next i
Application.EnableEvents = True
End Sub