Need worksheet Event for Sum

  • Thread starter Thread starter shahzad4u_ksa
  • Start date Start date
S

shahzad4u_ksa

Dear Sir,

I have one worksheet : DailyPurchase, and there are some fields

A: Date
B: Material Name
C: Qty
D: Price
E: Total Price

I want worksheet event who will calculate automatically when I enter
Qty and Price then Automatically it will give me the sum in E column.

Qty*Price in E column. without inserting the Sum furmula in worsheet.

Thanks hope you understand.

Regards


Shahzad
 
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "C:D"

On Error GoTo ws_exit
Application.EnableEvents = False

If Target.Cells.Count > 1 Then Exit Sub

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target

If Me.Cells(.Row, "C").Value <> "" And _
Me.Cells(.Row, "D").Value <> "" Then

Me.Cells(.Row, "E").Value = Me.Cells(.Row, "C").Value * _
Me.Cells(.Row, "D").Value
End If
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

'This is worksheet event code, which means that it needs to be
'placed in the appropriate worksheet code module, not a standard
'code module. To do this, right-click on the sheet tab, select
'the View Code option from the menu, and paste the code in.



--
---
HTH

Bob


(there's no email, no snail mail, but somewhere should be gmail in my addy)
 
Hi Shazad4u,

To allow for a deletion of a quantity or a price,
perhaps add an else condition.

Try replacing Bob's:
If Me.Cells(.Row, "C").Value <> "" And _
Me.Cells(.Row, "D").Value <> "" Then

Me.Cells(.Row, "E").Value = Me.Cells(.Row, "C").Value * _
Me.Cells(.Row, "D").Value
End If
Click to expand...

with

If Me.Cells(.Row, "C").Value <> "" And _
Me.Cells(.Row, "D").Value <> "" Then

Me.Cells(.Row, "E").Value = Me.Cells(.Row, "C").Value * _
Me.Cells(.Row, "D").Value
Else
Me.Cells(.Row, "E").ClearContents
End If
 
Perhaps, try this minor adaptation of
Bob's code:

'==========>>
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "C:D"
Const PWORD As String = "ABC" '<<==== CHANGE

On Error GoTo ws_exit
Application.EnableEvents = False

If Target.Cells.Count > 1 Then Exit Sub

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
Me.Unprotect Password:=PWORD
With Target
If Me.Cells(.Row, "C").Value <> "" And _
Me.Cells(.Row, "D").Value <> "" Then
Me.Cells(.Row, "E").Value _
= Me.Cells(.Row, "C").Value * _
Me.Cells(.Row, "D").Value
Else
Me.Cells(.Row, "E").ClearContents
End If
End With
End If

ws_exit:
Me.Protect Password:=PWORD
Application.EnableEvents = True
End Sub
''<<==========
 
Perhaps, try this minor adaptation of
Bob's code:

'==========>>
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "C:D"
Const PWORD As String = "ABC"     '<<==== CHANGE

    On Error GoTo ws_exit
    Application.EnableEvents = False

    If Target.Cells.Count > 1 Then Exit Sub

    If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
        Me.Unprotect Password:=PWORD
        With Target
            If Me.Cells(.Row, "C").Value <> "" And _
                Me.Cells(.Row, "D").Value <> "" Then
                Me.Cells(.Row, "E").Value _
                        = Me.Cells(.Row, "C").Value * _
                                Me.Cells(.Row, "D").Value
            Else
                Me.Cells(.Row, "E").ClearContents
            End If
        End With
    End If

ws_exit:
    Me.Protect Password:=PWORD
    Application.EnableEvents = True
End Sub
''<<==========

---
Regards.
Norman







- Show quoted text -
Click to expand...


Hi Norman

I am already using the following event in the worksheet.

Private Sub Worksheet_Change(ByVal Target As Range)

again same event giving the errors.

now what to do.

Regards.

Shahzad
 
Hi Shahzad,

=============
I am already using the following event in the worksheet.

Private Sub Worksheet_Change(ByVal Target As Range)

again same event giving the errors.

now what to do.
=============

Amalgamate the two Worksheet_Change
procedures into a single procedure, perhaps
adding the body of the other procedure
before the

End Sub

line of my suggested procedure.

If you experience problems with such
amalgamation, post the code of the other
procedure in a response in this thread,
 
Hi Shahzad,

=============
I am already using the following event in the worksheet.

Private Sub Worksheet_Change(ByVal Target As Range)

again same event giving the errors.

now what to do.
=============

Amalgamate the two Worksheet_Change
procedures into a single procedure, perhaps
adding the body of the other procedure
before the

        End Sub

line of my suggested procedure.

If you experience problems with such
amalgamation,  post the code of the other
procedure in a response in this thread,
Click to expand...


Good Morning Mr. Norman.

I tried your suggession, it is working vecy nice. E cell is protected
and no chance for deletion by mistake. very good.

Auto calculation is working perfect. I am very happy now.

Thank you very much.

Regards.

Shahzad
 
Back
Top