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

 

[johnnyL]

@SBNUT, I'm having difficulty what you want to achieve, so if you could just walk us through exactly what you want to happen when a different sheet is activated?

1) it looks like you want to delete rows 8 - 865 from the 'construction' sheet
2) Copy A8 - J500 from the 'Job List' sheet to the 'construction' sheet A8

Then I get a bit lost for a bit.

So can you explain exactly what you want to happen when a different sheet is activated?

 

[SQUIDD]

Johnny

yes. Agreed.

SBnut, if you can simply write step by step what you want to happen.
I started to re-write the code. But JBC answered and I assumed his code cracked it. But you lost me after you copied the range also as Johnny said.

I believe your current code may get your desired results. But has allot of steps that doesn’t need to happen.

 

[johnnyL]

Reason I ask is because I have tried to take your comments here and jive it with the actual code you posted and they don't match up.

Here is the code that I have stepped through from post #1:

Private Sub Worksheet_Activate()
Call Construction1
End Sub

Sub Construction1()
'
'
Rows("8:685").Select                                                ' This selects the rows from the Active sheet
Selection.Delete Shift:=xlUp                                        '  And Deletes them
Range("D14").Select                                                     ' Selects D14 on the Active sheet ???
Sheets("Job List").Select
Sheets("Job List").Range("A8:J8").Select                            ' Selects A8:J8 on the 'Job List' sheet
Sheets("Job List").Range(Selection, Selection.End(xlDown)).Select   '   and the rest of the way down the entire sheet
Selection.Copy                                                      '   Copies that range
Sheets("Construction").Select                                       ' Select the 'Construction' sheet
Range("A8").Select                                                  ' error 1004, Method of range class failed encountered

 

[SBNUT]

First thanks so much for your help. I can see why it gets into a loop with called because of the Worksheet_Activate. Here are the steps I am trying to carry out.

First let me say these worksheets are dynamic so one time there might be 10 lines in the worksheet, and the next it might be 100 lines. So I can set a static ending number. Also I have logos and some header information in rows 1 - 7 on both the "Job List" sheet and the "Construction" sheet.

Step 1: When a user goes to sheet "Construction" it automatically deletes all lines 8 through 685. (This clears any of the prior data so we always get the latest updates)
Step 2: I need to copy all the data from sheet "Job List" starting at row 8 until the end. There is data in columns A through J. (To do this, I selected the Range A8:J8 and did a selection down until the end of the data.
Step 3: I need to Paste this date from sheet "Job List" to cell A8 on sheet "Construction" (I now have all the latest data from sheet "Job List" posted to sheet "Construction".
Step 4: I need to sort the data just posted in sheet "Construction" by column "F" (cost type)
Step 5: I use the following code to Add headers and blank lines between the changes in column "F". (This code works just fine and should continue to work)

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

Step 6: The last part of the code that I have not written yet would be to total column "E" after each change in column "F". (I haven't gotten the above code working yet so I haven't tried this step yet.

This is what sheet "Construction" should look like after the code is ran. This was done with the code posted in my first post using the button on the top of the screen that runs a Macro instead of the Worksheet_Activate.

 

[SQUIDD]

hi

still needs a tidy up, but lets just see if this works 1st on dummy data set.

now we are not selection the sheet or activating it, you should be able to add this into worksheet activate sheet code like you wanted.

This code alos removes the autofilter, then re-applies the autofilter, but if the autofilter will always be there, remove this on both counts.

Sub COPY_MY_DATA()

Sheets("Construction").Rows("8:685").Delete
Sheets("Construction").Range("A7:J7").AutoFilter
lr = Range("'Job List'!A" & Rows.Count).End(xlUp).Row
Sheets("Job List").Range("A8:J" & lr).Copy
Sheets("Construction").Range("A8").PasteSpecial
Range("A7:J7").AutoFilter
    ActiveWorkbook.Worksheets("Construction").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Construction").AutoFilter.Sort.SortFields.Add2 Key:=Range("F7"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Construction").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

'add_lines your code
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 stops on this code.

lr = Range("'Job List'!A" & Rows.Count).End(xlUp).Row

 

[SQUIDD]

Does the sheet name match your sheet name exactly, upper and lowercase.

what is the error message.

dave

 

[SBNUT]

Yes they match. Does it have something to do with rows 1 - 7 has header information and merged cells unlike rows 8 through xxx?

 

[SQUIDD]

probably the autofilter actually

try this, this assumes your autofilter is always applied on sheet construction

Sub COPY_MY_DATA()

Sheets("Construction").Rows("8:685").Delete
lr = Range("'Job List'!A" & Rows.Count).End(xlUp).Row
Sheets("Job List").Range("A8:J" & lr).Copy
Sheets("Construction").Range("A8").PasteSpecial
    ActiveWorkbook.Worksheets("Construction").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Construction").AutoFilter.Sort.SortFields.Add2 Key:=Range("F7"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Construction").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With



End Sub

 

[SQUIDD]

sorry, found another fault

put the below in the sheet

Private Sub Worksheet_Activate()
COPY_MY_DATA
End Sub

then put this into a standard module

Sub COPY_MY_DATA()

Sheets("Construction").Rows("8:685").Delete
lr = Range("'Job List'!A" & Rows.Count).End(xlUp).Row
Sheets("Job List").Range("A8:J" & lr).Copy
Sheets("Construction").Range("A8").PasteSpecial
    ActiveWorkbook.Worksheets("Construction").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Construction").AutoFilter.Sort.SortFields.Add2 Key:=Range("F7"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Construction").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub