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

 

[SQUIDD]

in fact lets just disable events just before the sheet gets selected

Private Sub Worksheet_Activate()

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
Application.EnableEvents = False
Sheets("Construction").Select
Application.EnableEvents = True
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]

That worked like a charm...... I can't thank you enough. If you ever need any cabinets let me know and I'll give you a heck of a deal.

 

[johnnyL]

Private Sub Worksheet_Activate()
    Call Construction1
End Sub

Sub Construction1()
'
'   Turn Settings off
    Application.ScreenUpdating = False                                                  ' Turn Screen Updating off
    Application.Calculation = xlCalculationManual                                       ' Turn AutoCalculation off
    Application.EnableEvents = False                                                    ' Turn EnableEvents off
'
    Dim i               As Long
    Dim LastRowJobList  As Long
'
    Sheets("Construction").Rows("8:685").Delete Shift:=xlUp                     ' This selects the rows from the 'Construction' sheet And Deletes them
'
    LastRowJobList = Sheets("Job List").Range("A" & Rows.Count).End(xlUp).Row   ' Find last row in 'Job List' sheet
'
    Sheets("Job List").Range("A8:J" & LastRowJobList).Copy Sheets("Construction").Range("A8")   ' copy data from 'Job List' to 'Construction' sheet
'
    Sheets("Construction").Range("A8:J" & LastRowJobList).Sort Key1:=Range("F8"), Order1:=xlAscending, Header:=xlNo ' Sort 'Construction' data by column F
'
    For i = Sheets("Construction").Range("F" & Sheets("Construction").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
'
'   Turn Settings back on
    Application.EnableEvents = True                                                             ' Turn EnableEvents back on
    Application.Calculation = xlCalculationAutomatic                                            ' Turn AutoCalculation back on
    Application.ScreenUpdating = True                                                           ' Turn Screen Updating back on
End Sub

 

[SQUIDD]

LOL, yeah thanks

I just posted it slightly modified. in post number 31.

your welcome, but it will bug me for a while why it wasnt working, but anyway, if it works for you then great

dave

 

[SBNUT]

SQUIDD,
Can I run something by you? In this same spreadsheet I have over 300 checkboxes in column P rows 8 – 500. If a checkbox is checked on a row, then a discount will be taken on that line. Here is the tricky part. I have a master checkbox (Cell U6) that if checked and cell D11 > than $0 it will check the checkbox in P11. (this needs to happen for each row 8 through 500 using the value in column D for each row) This would be easy with an IF/and statement in the cell that the “P” checkboxes are linked to. However, we need to be able turn on and off the checkbox in P11 (and all rows) manually. When I do this, it wipes out the formula in the cell that the “P” checkbox is linked to. So I was thinking maybe some VBA code could be written that will check whenever cell U6 has changed. Look to see if that value is “TRUE” if so, then test all the rows and if cell D and row number is greater than $0 then set the checkbox in column P for that row as true. Is this possible?

 

[SQUIDD]

Hi.
So ultimately as follows.

if cell u6 changes. and is true.(ticked)
Tick all the tick boxes in column p automatically if column d is more than 0.
Correct?

Dave

 

[SQUIDD]

Hi

I would say you would get more responses to this question if you started a new post. Then you would just post me the link if you specifically wanted me to see.

Anyway, a little example below you may be able to work with.

You would need to assign this macro to your main checkbox you say is in U6(but would assume your checkboxes all are named?) My example I named this checkbox "MASTER".

Below is assuming your checkboxes are all a form control checkboxs, and your checkboxes are called "Check Box 1","Check Box 2","Check Box 3" and so on.

Adjust as required, for example, a=1 means the code is starting with Check Box 1, this may not be the case.
Also, my checkboxes are named "Check Box 1" and so on, so my code , If chkBox.Name = "Check Box " & a , you may need to rename this part, "Check Box "


hope that is clear

1 last thing, this part, "If chkBox.Name = "Check Box " & a And Range("D" & a + 4) > 0 Then" , the +4 means the data started in my example at row 5, i believe yours was 8? co change to +7.

Sub check_boxes()
Dim chkBox As CheckBox
If ActiveSheet.Shapes("MASTER").OLEFormat.Object.Value = 1 Then
    a = 1
        For Each chkBox In ActiveSheet.CheckBoxes
            If chkBox.Name = "Check Box " & a And Range("D" & a + 4) > 0 Then
                chkBox.Value = xlOn
            Else
                If chkBox.Name <> "MASTER" Then chkBox.Value = xlOff
            End If
            a = a + 1
        Next chkBox
ELSE
     'MORE CODE HERE IF THE TICK IS REMOVED FROM MASTER?
End If
End Sub

Dave

 

[SQUIDD]

this one now unticks all the check boxes if the master checkbox is unticked.

just in case you needed that

Sub check_boxes()
Dim chkBox As CheckBox
If ActiveSheet.Shapes("MASTER").OLEFormat.Object.Value = 1 Then
    a = 1
        For Each chkBox In ActiveSheet.CheckBoxes
            If chkBox.Name = "Check Box " & a And Range("D" & a + 7) > 0 Then
                chkBox.Value = xlOn
            Else
                If chkBox.Name <> "MASTER" Then chkBox.Value = xlOff
            End If
            a = a + 1
        Next chkBox
Else
    For Each chkBox In ActiveSheet.CheckBoxes
        If chkBox.Name <> "MASTER" Then chkBox.Value = xlOff
    Next chkBox
End If
End Sub