If I delete row from sheet then decrease amount in other sheet

[Omran Y]

Hi
in TT sheet when try deleting row then should decrease amount in column D for adjacent cells(NAME,NET AMOUNT) ignoring SALARY
into EMPLOYEES sheet base on matching NAME in column C between two sheets.

data.xlsm
	A	B	C	D
1	START DATE	LAST DATE	NAME	FIRST BALANCE
2	01/01/2023	31/01/2023	OMAR ALI OMAR	-20,000.00
3			SALARY	3,000.00
4			NET AMOUNT	-17,000.00
5
6
7	START DATE	LAST DATE	NAME	FIRST BALANCE
8	01/01/2023	31/01/2023	AHMED OMAR ALI	24,000.00
9			SALARY	12,000.00
10			NET AMOUNT	36,000.00
11
12
13	START DATE	LAST DATE	NAME	FIRST BALANCE
14	01/01/2023	31/01/2023	ALI MAHMUD OMAR	10,000.00
15			SALARY	2,500.00
16			NET AMOUNT	12,500.00
EMPLOYEES

data.xlsm
	A	B	C	D
1	NAME	FIRST BALANCE	SALARY	NET AMOUNT
2	11/02/2023	OMAR ALI OMAR	Advance payment by safe	2,000.00
3	12/02/2023	ALI MAHMUD OMAR	Advance payment by bank	2,500.00
4	13/02/2023	AHMED OMAR ALI	Pay payment safe	3,000.00
5	14/03/2023	OMAR ALI OMAR	Pay payment bank	5,000.00
TT

Delete row from TT sheet as in lastrow

data.xlsm
	A	B	C	D
1	NAME	FIRST BALANCE	SALARY	NET AMOUNT
2	11/02/2023	OMAR ALI OMAR	Advance payment by safe	2,000.00
3	12/02/2023	ALI MAHMUD OMAR	Advance payment by bank	2,500.00
4	13/02/2023	AHMED OMAR ALI	Pay payment safe	3,000.00
5	14/03/2023	OMAR ALI OMAR	Pay payment bank	5,000.00
TT

if the amount is minus for adjacent cells(NAME) then shoud decrease amount by add to amount for adjacent cells(NAME) and change amount for adjacent cells(NET AMOUNT) by sum amounts for for adjacent cells(NAME,SALARY) .
so see how become as highlighted by red

data.xlsm
	A	B	C	D
1	START DATE	LAST DATE	NAME	FIRST BALANCE
2	01/01/2023	31/01/2023	OMAR ALI OMAR	-15,000.00
3			SALARY	3,000.00
4			NET AMOUNT	-12,000.00
5
6
7	START DATE	LAST DATE	NAME	FIRST BALANCE
8	01/01/2023	31/01/2023	AHMED OMAR ALI	24,000.00
9			SALARY	12,000.00
10			NET AMOUNT	36,000.00
11
12
13	START DATE	LAST DATE	NAME	FIRST BALANCE
14	01/01/2023	31/01/2023	ALI MAHMUD OMAR	10,000.00
15			SALARY	2,500.00
16			NET AMOUNT	12,500.00
EMPLOYEES

another case to delete row from TT sheet

data.xlsm
	A	B	C	D
1	NAME	FIRST BALANCE	SALARY	NET AMOUNT
2	11/02/2023	OMAR ALI OMAR	Advance payment by safe	2,000.00
3	12/02/2023	ALI MAHMUD OMAR	Advance payment by bank	2,500.00
4	13/02/2023	AHMED OMAR ALI	Pay payment safe	3,000.00
TT

if the amount is positive for adjacent cells(NAME) then shoud decrease amount by subtract from amount for adjacent cells(NAME) and change amount for adjacent cells(NET AMOUNT) by sum amounts for for adjacent cells(NAME,SALARY) .
so see how become as highlighted by red

data.xlsm
	A	B	C	D
1	START DATE	LAST DATE	NAME	FIRST BALANCE
2	01/01/2023	31/01/2023	OMAR ALI OMAR	-15,000.00
3			SALARY	3,000.00
4			NET AMOUNT	-12,000.00
5
6
7	START DATE	LAST DATE	NAME	FIRST BALANCE
8	01/01/2023	31/01/2023	AHMED OMAR ALI	21,000.00
9			SALARY	12,000.00
10			NET AMOUNT	33,000.00
11
12
13	START DATE	LAST DATE	NAME	FIRST BALANCE
14	01/01/2023	31/01/2023	ALI MAHMUD OMAR	10,000.00
15			SALARY	2,500.00
16			NET AMOUNT	12,500.00
EMPLOYEES

 

[Omran Y]

bump

 

[mumps]

First make sure that column D in both sheets is formatted as 'Number'. Next copy and paste this code into the worksheet code module. Do the following: right click the tab name for your "TT" sheet and click 'View Code'. Paste the code into the empty code window that opens up. Close the code window to return to your sheet. Delete the desired row in "TT".

Dim lRow As Long, sName As String, Net As Long

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    sName = Range("B" & Target.Row)
    Net = Range("D" & Target.Row)
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    Dim LastRow As Long, fnd As Range
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If lRow > LastRow Then
        Set fnd = Sheets("EMPLOYEES").Range("C:C").Find(sName, LookIn:=xlValues, lookat:=xlWhole)
        If Not fnd Is Nothing Then
            If fnd.Offset(, 1) < 0 Then
                fnd.Offset(, 1) = fnd.Offset(, 1) + Net
                fnd.Offset(2, 1) = fnd.Offset(2, 1) + Net
            Else
                fnd.Offset(, 1) = fnd.Offset(, 1) - Net
                fnd.Offset(2, 1) = fnd.Offset(2, 1) - Net
            End If
        End If
    End If
    Application.ScreenUpdating = True
End Sub

 

[Omran Y]

Great !
I thought my thread is not clear .
many thanks buddy .

 

[mumps]

You are very welcome.