ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Delete Row and Auto Subtract (https://www.excelbanter.com/excel-programming/404068-delete-row-auto-subtract.html)

hon123456

Delete Row and Auto Subtract
 
Dear All,

I have two worksheet with the following data,

Sheet 1

Invoice Number Qty
Invoice-001 6



Sheet 2

Invoice Number Qty
Invoice-001 1

Now what I want is if I delete the Invoice-001 row in Sheet2,
the Qty of Invoice-001 in Sheet1
will be subtracted by the Qty of Invoice-001 of Sheet2. How Can I do
that?

Thanks.



Dave D-C[_3_]

Delete Row and Auto Subtract
 
This has a lot of extra goodies (baggage?), but it
shows one approach -- using a popup menu.
(Assumes InvNum and Qty are columns A & B)
(It needs error checking to be added) Dave D-C
In Module1:
Option Explicit
Public gSwCancel As Boolean

Sub MakePopup(pCBName$)
gSwCancel = True
Dim CB1 As CommandBar, CBC1 As CommandBarControl
On Error Resume Next
Application.CommandBars(pCBName).Delete
On Error GoTo 0 ' restore error processing
Set CB1 = Application.CommandBars.Add(pCBName, msoBarPopup, False,
True)
End Sub

Sub MakePUButton(pCBName$, pCaption$, pOnAction$)
Dim CB1 As CommandBar, CBC1 As CommandBarControl
Set CB1 = Application.CommandBars(pCBName)
If pCaption = "" Then
Set CBC1 = CB1.Controls(CB1.Controls.Count)
CBC1.BeginGroup = True
Else
Set CBC1 = CB1.Controls.Add(msoControlButton)
CBC1.Style = msoButtonCaption
CBC1.Caption = pCaption
CBC1.OnAction = pOnAction
End If
End Sub

In Sheet2:
Option Explicit
Dim gRow&

Private Sub Worksheet_BeforeRightClick( _
ByVal Target As Excel.Range, Cancel As Boolean)
If Target.Rows.Count < 1 Then Exit Sub
gRow = Target.Row
Call MakePopup("DC1") ' sets gSwCancel = True
Call MakePUButton("DC1", "DelRow", "Sheet2.DelRow")
Call MakePUButton("DC1", "True", "Sheet2.MenuTrue")
Call MakePUButton("DC1", "", "") ' begingroup
Call MakePUButton("DC1", "False", "Sheet2.MenuFalse")
Application.CommandBars("DC1").ShowPopup
Cancel = gSwCancel
End Sub

Sub DelRow() ' ** This is the meat of it **
Const ShName = "Sheet1" ' other sheet
Dim iRow&, InvNum$, Qty&
iRow = Sheets(ShName).Range("A:A").Find(Cells(gRow, 1)).Row
InvNum = Cells(gRow, 1)
Qty = Sheets(ShName).Cells(iRow, 2) - Cells(gRow, 2)
Sheets(ShName).Cells(iRow, 2) = Qty
Rows(gRow).Delete
MsgBox "New Qty for " & InvNum & " is " & Qty
End Sub

Sub MenuTrue()
Beep
' gSwCancel = True ' already True
End Sub

Sub MenuFalse()
Beep
gSwCancel = False
End Sub

hon123456 wrote:
Dear All,
I have two worksheet with the following data,

Sheet 1
Invoice Number Qty
Invoice-001 6

Sheet 2
Invoice Number Qty
Invoice-001 1

Now what I want is if I delete the Invoice-001 row in Sheet2,
the Qty of Invoice-001 in Sheet1
will be subtracted by the Qty of Invoice-001 of Sheet2. How Can I do
that?



hon123456

Delete Row and Auto Subtract
 
Thanks Dave,

But my problem is that I need the Macro to run on any workbook
that I will open. The macro will not run in a fixed workbook. So how
can I change the code
to let it run on any workbook that I have open.

Thanks

Dave D-C[_3_]

Delete Row and Auto Subtract
 
I suggest doing a search on Excel and AddIn.
And mabye MVP.
But I might be wrong. Dave

hon123456 wrote:
Thanks Dave,

But my problem is that I need the Macro to run on any workbook
that I will open. The macro will not run in a fixed workbook. So how
can I change the code
to let it run on any workbook that I have open.

Thanks



hon123456

Delete Row and Auto Subtract
 
Can I Change the code as follows:

Private Sub ActiveWorkbook.Worksheet2_BeforeRightClick( _
ByVal Target As Excel.Range, Cancel As Boolean)
If Target.Rows.Count < 1 Then Exit Sub
gRow = Target.Row
Call MakePopup("DC1") ' sets gSwCancel = True
Call MakePUButton("DC1", "DelRow", "Sheet2.DelRow")
Call MakePUButton("DC1", "True", "Sheet2.MenuTrue")
Call MakePUButton("DC1", "", "") ' begingroup
Call MakePUButton("DC1", "False", "Sheet2.MenuFalse")
Application.CommandBars("DC1").ShowPopup
Cancel = gSwCancel
End Sub


Thanks


Dave D-C[_3_]

Delete Row and Auto Subtract
 
hon,
You want the popup menu and associated routines available
for all workbooks, right?

See
http://groups.google.com/group/micro...37c15304ea45c2
in which Tom O refers to
http://support.microsoft.com/kb/q158244/
which is handling application events. From that I got
the following (on XL97) which should do what you want.
In a separate workbook (Book1), add a Class module (Class1) with
Option Explicit
Public WithEvents AppEvent As Application

Private Sub AppEvent_SheetBeforeDoubleClick( _
ByVal Sh As Object, _
ByVal Target As Excel.Range, _
Cancel As Boolean)

Cancel = True
Dim CB1 As CommandBar, CBC1 As CommandBarControl
On Error Resume Next
Application.CommandBars("XYZ").Delete
On Error GoTo 0 ' restore error processing
Set CB1 = Application.CommandBars.Add("XYZ", msoBarPopup, False,
True)
Set CBC1 = CB1.Controls.Add(msoControlButton)
CBC1.Style = msoButtonCaption
CBC1.Caption = "Doit"
CBC1.OnAction = "SubDoit"
Application.CommandBars("XYZ").ShowPopup
End Sub

On the same workbook, add a Standard module (Module1) with
Option Explicit
Dim MyObject As Class1

Sub LoadEventHandler()
Set MyObject = New Class1
Set MyObject.AppEvent = Application
MsgBox "Event handler is loaded"
End Sub

Sub SubDoit() ' your stuff goes here
Dim WbName$, WsName$
WbName = ActiveSheet.Parent.Name
WsName = ActiveSheet.Name
MsgBox "You double clicked" & vbCrLf & _
WbName & vbCrLf & _
WsName & vbCrLf & _
ActiveCell.Address
Workbooks(WbName).Sheets(WsName).Cells(1, 1) = "Touch11"
Workbooks(WbName).Sheets("Sheet2").Cells(2, 2) = "Touch22"
End Sub

Then run LoadEventHandler and it's done!
You have to keep Book1 open in order to keep the event handler.
You could probably put book1 stuff in Personal.xls or an Add-In.

This is neat stuff!

hon123456 wrote:
Can I Change the code as follows:

Private Sub ActiveWorkbook.Worksheet2_BeforeRightClick( _
ByVal Target As Excel.Range, Cancel As Boolean)
[makes a popup menu and does the .Popup]
End Sub

Thanks




All times are GMT +1. The time now is 08:29 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com