move and delete rows contains minus and positive value from range to another

[Mussa]

Hi,
I would macro to deal with about 1000 names for each range into two sheets.
in RECEIVABLE sheet when contains minus value in BALANCE column then will delete it and brings rows contains positive values in BALANCE column from PAYPAL sheet and recalculate as in BALANCE column and in TOTAL row.
as to PAYPAL sheet when contains positive value in BALANCE column then will delete it and brings rows contains minus values in BALANCE column from RECEIVABLE sheet and recalculate as in BALANCE column and in TOTAL row. Also should delete row contains zero in BALANCE column for both sheets.

MUSA1.xlsm
	A	B	C	D	E
1	ITEM	NAME	DEBIT	CREDIT	BALANCE
2	1	AMUSSAN	4,000.00		4,000.00
3	2	ANISAMAN	3,000.00	3,000.00	0.00
4	3	ASSUMAN	5,000.00	6,000.00	-1,000.00
5	4	MUSSA	2,000.00	1,000.00	1,000.00
6	5	MUSSAN	3,000.00		3,000.00
7	6	MUSSI	1,300.00	6,000.00	-4,700.00
8	7	OSMAAN	1,100.00	5,000.00	-3,900.00
9	TOTAL		19,400.00	21,000.00	-1,600.00
RECEIVABLE

Cell Formulas
Range	Formula
E2:E8	E2	=C2-D2
C9:E9	C9	=SUM(C2:C8)

MUSA1.xlsm
	A	B	C	D	E
1	ITEM	NAME	DEBIT	CREDIT	BALANCE
2	1	AMEER	7,000.00	3,000.00	4,000.00
3	2	AMIR		300.00	-300.00
4	3	ASIIF	6,000.00	5,000.00	1,000.00
5	4	AZIZ		12,000.00	-12,000.00
6	5	SAFAR	8,000.00	2,000.00	6,000.00
7	6	SAMMER	1,100.00	7,000.00	-5,900.00
8	7	SANDI	7,000.00	6,000.00	1,000.00
9	8	SANI	15,000.00	6,000.00	9,000.00
10	TOTAL		44,100.00	41,300.00	2,800.00
PAYABLE

Cell Formulas
Range	Formula
E2:E9	E2	=C2-D2
C10:E10	C10	=SUM(C2:C9)

result

MUSA1.xlsm
	A	B	C	D	E
1	ITEM	NAME	DEBIT	CREDIT	BALANCE
2	1	AMEER	7,000.00	3,000.00	4,000.00
3	2	AMUSSAN	4,000.00		4,000.00
4	3	ASIIF	6,000.00	5,000.00	1,000.00
5	4	MUSSA	2,000.00	1,000.00	1,000.00
6	5	MUSSAN	3,000.00		3,000.00
7	6	SAFAR	8,000.00	2,000.00	6,000.00
8	7	SANDI	7,000.00	6,000.00	1,000.00
9	8	SANI	15,000.00	6,000.00	9,000.00
10	TOTAL		52,000.00	23,000.00	29,000.00
RECEIVABLE

Cell Formulas
Range	Formula
E2:E9	E2	=C2-D2
C10:E10	C10	=SUM(C2:C9)

MUSA1.xlsm
	A	B	C	D	E
1	ITEM	NAME	DEBIT	CREDIT	BALANCE
2	1	AMIR		300.00	-300.00
3	2	ASSUMAN	5,000.00	6,000.00	-1,000.00
4	3	AZIZ		12,000.00	-12,000.00
5	4	MUSSI	1,300.00	6,000.00	-4,700.00
6	5	OSMAAN	1,100.00	5,000.00	-3,900.00
7	6	SAMMER	1,100.00	7,000.00	-5,900.00
8	TOTAL		8,500.00	36,300.00	-27,800.00
PAYABLE

Cell Formulas
Range	Formula
E2:E7	E2	=C2-D2
C8:E8	C8	=SUM(C2:C7)

every time I will add new data and change every time for both sheets.
last thing if there is way to get rid of the formulas.
thanks in advanced.

 

[Fuji]

Sub test()
    Dim s$(1), e, ws As Worksheet
    s(1) = "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & _
        ";Extended Properties='Excel 12.0;HDR=Tes';"
    s(0) = "Select * From `RECEIVABLE$` Where `Name` Is Not Null " & _
        "Union Select * From `PAYABLE$` Where `Name` Is Not Null;"
    With CreateObject("ADODB.Recordset")
        .Open s(0), s(1), 3, 3, 1
        For Each e In Array(Array("receivable", ">"), Array("payable", "<"))
            Set ws = Sheets(e(0))
            .Filter = ""
            .Filter = "[BALANCE]" & e(1) & "0"
            ws.[a1].CurrentRegion.Offset(1).ClearContents
            ws.[a2].CopyFromRecordset .DataSource
            With ws.[a1].CurrentRegion
                .Offset(1).Columns(1) = Evaluate("row(1:" & .Rows.Count & ")")
                .Rows(.Rows.Count + 1).Cells(1) = "TOTAL"
                .Rows(.Rows.Count + 1).Range("c1:e1").FormulaR1C1 = "=sum(r2c:r[-1]c)"
            End With
        Next
    End With
End Sub

 

[Mussa]

Awesome !
may you fix the formatting and borders when increase data will leave the color and borders for TOTA word in last row and will not show the borders . so should delete the color left in TOTAL word and highlight for new location for TOTAL word when move to the bottom and create borders , and if decrease data by move to above then delete the color left in TOTAL word , borders and highlight for new location for TOTAL word when move to the above .
thanks

 

[Fuji]

Sub test()
    Dim s$(1), e, ws As Worksheet
    s(1) = "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & _
        ";Extended Properties='Excel 12.0;HDR=Tes';"
    s(0) = "Select * From `RECEIVABLE$` Where `Name` Is Not Null " & _
        "Union Select * From `PAYABLE$` Where `Name` Is Not Null;"
    With CreateObject("ADODB.Recordset")
        .Open s(0), s(1), 3, 3, 1
        For Each e In Array(Array("receivable", ">"), Array("payable", "<"))
            Set ws = Sheets(e(0))
            With ws.[a1].CurrentRegion.Offset(1)
                .Borders.LineStyle = xlNone
                .Interior.ColorIndex = xlNone
                .Font.Bold = False
                .ClearContents
            End With
            .Filter = ""
            .Filter = "[BALANCE]" & e(1) & "0"
            ws.[a2].CopyFromRecordset .DataSource
            With ws.[a1].CurrentRegion
                .Offset(1).Columns(1) = Evaluate("row(1:" & .Rows.Count & ")")
                With .Rows(.Rows.Count + 1)
                    .Cells(1) = "TOTAL"
                    .Cells(1).Font.Bold = True
                    .Cells(1).Interior.Color = .Parent.Range("a1").Interior.Color
                    .Range("c1:e1").FormulaR1C1 = "=sum(r2c:r[-1]c)"
                End With
            End With
        Next
    End With
End Sub

 

[Mussa]

You misunderstood me.
should delete formatting and borders for there is no data in some rows .

 

[Fuji]

Then I don't understand what you talking about.
Good luck.

 

[Mussa]

Maybe the pictures help you
this is what I got based on the first code

what I want

 

[Fuji]

The code I post in #4 should do it, just missing new borders.

                End With
                .Resize(.Rows.Count + 1).Borders.Weight = 2   '<--- add this line
            End With

 

[Mussa]

Perfect !
thank you so much.