Worksheet Change Event

I

ianfrancis56

New Member
Joined
Aug 10, 2011
Messages
34
All,

I'm a little stumped here....I am either missing it in posts and tutorials or I haven't see it. I have a range in Sheets("Labor") where the user enters the quantity and days. I know a Worksheet Change Event can't be activated by a cell with a formula in it, so that's why I am focusing on these since they are user entered. Basically I want any time a quantity and days entry or deletion occurs to trigger the below VBA.

Code: 
Sub PEOFTECalc_Click()
Application.ScreenUpdating = False

Dim i@, lin@, LabCatCt@, LabCt@, PEOCt@, FirstRw@, LastRw@

    lin = 13
    PEOCt = ActiveSheet.Range("G" & Rows.Count).End(xlUp).Row
    Lab = Sheets("Labor").Range("G5:M35")
    LabCt = 0

        With Sheets("PEO-EIS FTE Calculation")
            If .Cells(lin, "G") <> "" Then
                For i = lin To .Cells(lin, "G").End(xlDown).Row
                    .Cells(i, "G").EntireRow.ClearContents
                Next i
            End If
                FirstRw = Sheets("Labor").UsedRange.Cells(5, "G").Row
                LastRw = Sheets("Labor").Cells(5, "G").End(xlDown).Row
                    For i = FirstRw To LastRw Step 1
                        If Sheets("Labor").Cells(i, "Q").Value <> "" Then
                            .Rows(lin).EntireRow.Insert
                            .Cells(lin, "G") = Sheets("Labor").Cells(i, "G")
                            .Cells(lin, "I") = .Application.VLookup(.Cells(lin, "G"), Lab, 4)
                            .Cells(lin, "H") = .Application.VLookup(.Cells(lin, "G"), Lab, 7)
                            .Cells(lin, "J") = .Cells(lin, "H") * .Cells(lin, "I")
                            lin = lin + 1
                            LabCt = LabCt + 1
                        End If
                    Next i
                    
                FirstRw = .UsedRange.Cells(13 + LabCt, "G").Row
                LastRw = .UsedRange.Rows(.UsedRange.Rows.Count).Row
                    For i = LastRw To FirstRw Step -1
                        With Cells(i, "G")
                            If .Value = "" Then
                               .EntireRow.Delete xlShiftDown
                            End If
                        End With
                    Next i
                    
                    .Rows(LabCt + 13).EntireRow.Insert
                    .Rows(LabCt + 15).EntireRow.Insert
                    
                    .Range("G13:G" & Rows.End(xlDown).Row).Rows.AutoFit
                    .Rows(LabCt + 13).RowHeight = 3.75
                    .Rows(LabCt + 15).RowHeight = 3.75
                    
                    .Cells(LabCt + 14, "H") = Application.Sum(.Range("H13:H" & LabCt + 13))
                    .Cells(LabCt + 14, "J") = Application.Sum(.Range("J13:J" & LabCt + 13))
                    .Cells(LabCt + 17, "J") = .Cells(LabCt + 14, "H") / .Cells(LabCt + 16, "H")
                    
        End With
         
End Sub
['/CODE]

Thanks!
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Sort by date Sort by votes
Change
Code: 
Sub PEOFTECalc_Click()

to this
Code: 
Sub Worksheet_SelectionChange(ByVal Target as Range)
 
Upvote 0
"I know a Worksheet Change Event can't be activated by a cell with a formula in it, so that's why I am focusing on these since they are user entered. Basically I want any time a quantity and days entry or deletion occurs to trigger the below VBA."

It's not possible to answer your question the way you asked it. If you want a Click event of (presumably) a button from the (presumably) activex control toolbox you'd need to (definitely) clarify the worksheet name or its code name if it is not (possibly) the active sheet.

You also are not clear about which cells are the precedents for the formula(s) that you want to trigger your change event.

But I bolded part of what you wrote above, because if this is (presumably some more) one formula or even a few formulas you are monitoring, you can capture the actions for just that formula in a Worksheet Calculation event.

Bottom line, take a step back and explain what cells and what ranges and what kind of buttons on what sheets you are talking about. The solution might be as simple as looking at one cell with a formula, though we cannot tell from here unless you clarify.
 
Upvote 0
Tom,

Took your advice and took a step back. It is definitely a Worksheet_Calculation event. I feel I am closer to a solution, but am still missing something, as the code is not automatically triggering the action.

Now, to give a clearer description.
  • In Sheets("Labor") Rows K and L are user entries, for Quantity and Days (the number of laborers and the days each will be working).
    This will cause a calculation to occur in Row M to determine the total hours, then a calculation in N to determine the cost of the labor.
    Columns O and P then calculate two other costs.
    Column Q sums Columns N:P for a total cost.

Sheets("PEO-EIS FTE Calculation") uses this information to populate and format itself with this code:

Code: 
Sub PEOFTECalc()

Application.ScreenUpdating = False


Dim i@, lin@, LabCatCt@, LabCt@, PEOCt@, FirstRw@, LastRw@

    lin = 13
    PEOCt = Sheets("PEO-EIS FTE Calculation").Range("G" & Rows.Count).End(xlUp).Row
    Lab = Sheets("Labor").Range("G5:M35")
    LabCt = 0
    
        With Sheets("PEO-EIS FTE Calculation")
            If .Cells(lin, "G") <> "" Then
                For i = lin To .Cells(lin, "G").End(xlDown).Row
                    .Cells(i, "G").EntireRow.ClearContents
                Next i
            End If
                FirstRw = Sheets("Labor").UsedRange.Cells(5, "G").Row
                LastRw = Sheets("Labor").Cells(5, "G").End(xlDown).Row
                    For i = FirstRw To LastRw Step 1
                        If Sheets("Labor").Cells(i, "Q").Value <> "" Then
                            .Rows(lin).EntireRow.Insert
                            .Cells(lin, "G") = Sheets("Labor").Cells(i, "G")
                            .Cells(lin, "I") = .Application.VLookup(.Cells(lin, "G"), Lab, 4)
                            .Cells(lin, "H") = .Application.VLookup(.Cells(lin, "G"), Lab, 7)
                            .Cells(lin, "J") = .Cells(lin, "H") * .Cells(lin, "I")
                            lin = lin + 1
                            LabCt = LabCt + 1
                        End If
                    Next i
                    
                FirstRw = .UsedRange.Cells(13 + LabCt, "G").Row
                LastRw = .UsedRange.Rows(.UsedRange.Rows.Count).Row
                    For i = LastRw To FirstRw Step -1
                        With Cells(i, "G")
                            If .Value = "" Then
                               .EntireRow.Delete xlShiftDown
                            End If
                        End With
                    Next i
                    
                    .Rows(LabCt + 13).EntireRow.Insert
                    .Rows(LabCt + 15).EntireRow.Insert
                    .Rows(LabCt + 17).EntireRow.Insert
                    
                    .Range("G13:G" & Rows.End(xlDown).Row).Rows.AutoFit
                    .Rows(LabCt + 13).RowHeight = 3.75
                    .Rows(LabCt + 15).RowHeight = 3.75
                    .Rows(LabCt + 17).RowHeight = 3.75
                    
                    .Cells(LabCt + 14, "H") = Application.Sum(.Range("H13:H" & LabCt + 13))
                    .Cells(LabCt + 14, "J") = Application.Sum(.Range("J13:J" & LabCt + 13))
                    .Cells(LabCt + 18, "J") = .Cells(LabCt + 14, "H") / .Cells(LabCt + 16, "H")
                    
        End With
End Sub

I am trying to auto-update Sheets("PEO-EIS FTE Calculation") by examining the total cost it shows and the one shown in Sheets("Labor"). Sheets("Labor") would change as the user enters Quantity and Days in columns K and L, causing a calculation to occur and changing the total cost. This would make the two total cost figures different, triggering PEOFTECalc. However, it's not triggering...

Code: 
Sub Worksheet_Calculate()
Dim i@, d@

lin = 16
i = Sheets("Labor").Cells(5, "Q").End(xlDown).Row
d = Sheets("PEO-EIS FTE Calculation").Cells(lin + LabCt, "J").End(xlDown).Row

    If Sheets("PEO-EIS FTE Calculation").Cells(i, "Q") _
    <> Sheets("Labor").Cells(lin + d, "J") Then
        Call PEOFTECalc
    End If
End Sub

Any suggestions? I hope I articulated the situation and problem a bit better this time. Thank!
 
Upvote 0
Just wanted to post that I got it worked out! Put this in the Sheets("Labor")

Code: 
Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("L5:L35")) Is Nothing Then
        If Target.Value = "" Or Target.Value > 0 Then
            Call PEOFTECalc
        End If
    End If
End Sub

And altered PEOFTECalc to look like this:

Code: 
Sub PEOFTECalc()
Application.ScreenUpdating = False

Dim i@, LabCt@, PEOCt@, FirstRw@, LastRw@, lin@
    
    lin = 13
    Lab = Sheets("Labor").Range("G5:M35")
    LabCt = 0
    FirstRw = Sheets("Labor").Cells(5, "G").Row
    LastRw = Sheets("Labor").Cells(5, "G").End(xlDown).Row
    
    With Sheets("PEO-EIS FTE Calculation")
             
        If .Cells(14, "G") = "" Then
            .Range("G13").EntireRow.Delete
        Else
            .Range("G13:G" & .Cells(13, "G").End(xlDown).Row).EntireRow.Delete
        End If
            
        For i = FirstRw To LastRw Step 1
            If Sheets("Labor").Cells(i, "Q").Value <> "" Then
                .Rows(lin).EntireRow.Insert
                .Cells(lin, "G") = Sheets("Labor").Cells(i, "G")
                .Cells(lin, "I") = .Application.VLookup(.Cells(lin, "G"), Lab, 4)
                .Cells(lin, "H") = .Application.VLookup(.Cells(lin, "G"), Lab, 7)
                .Cells(lin, "J") = .Cells(lin, "H") * .Cells(lin, "I")
                    lin = lin + 1
                    LabCt = LabCt + 1
            End If
        Next i
                    
        FirstRw = .Cells(13, "G").End(xlDown).Row
        LastRw = .UsedRange.Rows(.UsedRange.Rows.Count).Row
        
        For i = FirstRw To LastRw
            With Cells(i, "G")
                If .Value = "" Then
                    .EntireRow.Delete xlShiftUp
                End If
            End With
        Next i
                    
        .Range("G13:G" & Rows.End(xlDown).Row).Rows.AutoFit
        .Rows(LabCt + 13).RowHeight = 3.75
        .Rows(LabCt + 15).RowHeight = 3.75
        .Rows(LabCt + 17).RowHeight = 3.75
                    
        .Cells(LabCt + 14, "H") = Application.Sum(.Range("H13:H" & LabCt + 13))
        .Cells(LabCt + 14, "J") = Application.Sum(.Range("J13:J" & LabCt + 13))
        .Cells(LabCt + 18, "J") = .Cells(LabCt + 14, "H") / .Cells(LabCt + 16, "H")
        .Cells(LabCt + 19, "J") = .Cells(LabCt + 14, "J") / .Cells(LabCt + 18, "J")
    
    End With
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Solved
Help needed with simple macro
2
Replies
15
Views
215
MARK858
MARK858
N
  • Question Question
AutoFilter Field Macro Returns a Header Row only
2
Replies
11
Views
211
MARK858
MARK858
P
  • Solved
VBA - Clear one cell if another one changes in the same row
Replies
7
Views
468
Alex Blakenburg
A
Sufiyan97
  • Question Question
Add Auto sum in selected blank cells VBA
Replies
4
Views
365
Sufiyan97
Sufiyan97
T
  • Solved
Help with VBA Code in Excel
Replies
2
Views
338
tixarah
T

Forum statistics

Threads
1,224,603
Messages
6,179,850
Members
452,948
Latest member
UsmanAli786

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top