Delete rows based on match criteria in two excel files or single Excel File

**fixer** · 03-22-2020, 09:48 PM

vba is placed in a sepearte file macro.xlsm
and there are two more files 1.xlsx & 2.xlsx
all files are located in different path
i am looking to slve this problem by vba macro
if column A of 1.xlsx matches with column A of of 2.xlsx then calculate the data in that row and if the number is positive then delete all the numbers from that entire row (numbers is starting from column B) & if it is negative then do nothing
example in current case acc matches dlf matches and tata matches
acc is negative (40-50=-10) then do nothing
dlf is positive (10+200=210) then delete the numbers which is starting from column B i.e 10 & 200
and so on
only macro.xlsm is open so we have to open that file

**DocAElstein** · 03-23-2020, 04:17 AM

Try this

Code:

Sub conditionally_delete_entire_row() ' http://www.excelfox.com/forum/showthread.php/2436-conditionally-delete-entire-row
Rem 1  workbooks, Worksheets info  '  only macro.xlsm is open so we have to open that file
Dim Wb1 As Workbook, Wb2 As Workbook, Ws1 As Worksheet, Ws2 As Worksheet
Workbooks.Open Filename:=ThisWorkbook.Path & "\1.xlsx"
 Set Wb1 = ActiveWorkbook
 Set Ws1 = Wb1.Worksheets.Item("Sheet1") ' worksheet with string tab name of  Sheet1
 Set Wb2 = Workbooks.Open(Filename:=ThisWorkbook.Path & "\2.xlsx")
 Set Ws2 = Wb2.Worksheets.Item(1) ' worksheet of first tab
'1b Ranges
Dim Rng1 As Range, Rng2 As Range
 Set Rng1 = Ws1.Range("A1").CurrentRegion: Set Rng2 = Ws2.Range("A1").CurrentRegion
Dim Rng1A As Range, Rng2A As Range
 Set Rng1A = Rng1.Range("A1:A" & Rng1.Rows.Count & ""): Set Rng2A = Rng2.Range("A1:A" & Rng2.Rows.Count & "")
Rem 2 take each cell in column A of 1.xlsx and compare it with  each cell in column A of of 2.xlsx
Dim RngS1 As Range, RngS2 As Range
    For Each RngS1 In Rng1A ' each cell in column A of 1
        For Each RngS2 In Rng2A ' each cell in column A of 2
            If RngS1.Value = RngS2.Value Then ' compare .. if column A of 1.xlsx matches with column A of of 2.xlsx
            Dim DtaClc As Long ' calculate the data in that row
             Let DtaClc = Application.WorksheetFunction.Sum(RngS2.Resize(1, Rng2.Columns.Count)) ' https://docs.microsoft.com/de-de/office/vba/api/excel.worksheetfunction.sum
                If DtaClc > 0 Then ' delete all the numbers from that entire row (numbers is starting from column B)
                 'RngS2.Offset(0, 1).Resize(1, Rng2.Columns.Count - 1).Delete shift:=xlToLeft
                 RngS2.Offset(0, 1).Resize(1, Rng2.Columns.Count - 1).ClearContents
                Else
                ' Dtaclc  is negative then do nothing
                End If
            Else
            ' column A of 1.xlsx does not match with column A of of 2.xlsx -  do nothing
            End If
        Next RngS2
    Next RngS1
End Sub

**fixer** · 03-23-2020, 10:39 AM

Thnx Alot Doc Sir for ur Great Effort Sir
Problem Solved

**fixer** · 03-23-2020, 10:44 AM

vba is placed in a seperate files macro.xlsm
& there are two more files 2.xlsx and 1.xlsx
all files are located in a different place
i uploaded the pic of 1.xlsx & 2.xlsx plz look sir
if column A of 1.xlsx matches with column B of 2.xlsx then keep that entire row of 2.xlsx & if not matches then delete the entire row of 2.xlsx
in this example 3rd row will be deleted of 2.xlsx
i need the macro of the same sir
so plz have a look into this problem and help me in solving this problem sir
plz see the sample file

**DocAElstein** · 03-23-2020, 02:57 PM

Change to this

Code:

Dim Rng1A As Range, Rng2B As Range ' , Rng2A As Range
 Set Rng1A = Rng1.Range("A1:A" & Rng1.Rows.Count & ""): Set Rng2B = Rng2.Range("B1:B" & Rng2.Rows.Count & "")  ' : Set Rng2A = Rng2.Range("A1:A" & Rng2.Rows.Count & "")
Rem 2 take each row in column A of 1.xlsx and compare it with  each row in column B of of 2.xlsx
Dim Rws As Long
    For Rws = Rng1.Rows.Count To 2 Step -1
        If Rng1A.Item(Rws).Value = Rng2B.Item(Rws).Value Then
        ' Do nothing
        Else
         Rng2B.Item(Rws).EntireRow.Delete Shift:=xlUp
        End If
    Next Rws
End Sub

Before:-
_____ Workbook: 1.xlsx ( Using Excel 2007 32 bit )

_Row\^Col	A	B
1
2	ACC	6
3	DLF	4
4

Worksheet: Sheet1

_____ Workbook: 2.xlsx ( Using Excel 2007 32 bit )

_Row\^Col	A	B	C	D	E	F	G
1	Exchange
2	NSE	ACC	EQ	10	11	12	13
3	NSE	ADANIENT	EQ	8	7	6	5
4	NSE	DLF	EQ	1	2	3	4
5

Worksheet: Sheet1

After:

_____ Workbook: 1.xlsx ( Using Excel 2007 32 bit )

_Row\^Col	A	B
1
2	ACC	6
3	DLF	4
4

Worksheet: Sheet1

_____ Workbook: 2.xlsx ( Using Excel 2007 32 bit )

_Row\^Col	A	B	C	D	E	F
1	Exchange
2	NSE	ACC	EQ	10	11	12
3	NSE	DLF	EQ	1	2	3
4
5

Worksheet: Sheet1

**fixer** · 03-23-2020, 05:10 PM

Code:

Sub conditionally_delete()
On Error Resume Next
Dim Wb1 As Workbook, Wb2 As Workbook, Ws1 As Worksheet, Ws2 As Worksheet
 Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Upstox\STEP1U.xlsb")
 Set Ws1 = Wb1.Worksheets.Item("Sheet1") ' worksheet with string tab name of  Sheet1
 Set Wb2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
 Set Ws2 = Wb2.Worksheets.Item(1) ' worksheet of first tab
'1b Ranges
Dim Rng1A As Range, Rng2B As Range
 Set Rng1A = Rng1.Range("A1:A" & Rng1.Rows.Count & ""): Set Rng2B = Rng2.Range("B1:B" & Rng2.Rows.Count & "")  ' : Set Rng2A = Rng2.Range("A1:A" & Rng2.Rows.Count & "")
Rem 2 take each row in column A of 1.xlsx and compare it with  each row in column B of of 2.xlsx
Dim Rws As Long
    For Rws = Rng1.Rows.Count To 2 Step -1
        If Rng1A.Item(Rws).Value = Rng2B.Item(Rws).Value Then
        ' Do nothing
        Else
         Rng2B.Item(Rws).EntireRow.Delete Shift:=xlUp
        End If
    Next Rws
    
    Wb1.Save
    Wb1.Close
    Wb2.Save
    Wb2.Close
    
End Sub

I am getting error with this line Doc Sir

Code:

Set Rng1A = Rng1.Range("A1:A" & Rng1.Rows.Count & ""): Set Rng2B = Rng2.Range("B1:B" & Rng2.Rows.Count & "")  ' : Set Rng2A = Rng2.Range("A1:A" & Rng2.Rows.Count & "")

plz have a relook Doc Sir

**DocAElstein** · 03-23-2020, 05:21 PM

You should be able to see a possible problem ...
Where is your Rng1 and Rng1 defined????
You must have Rng1 and Rng1...
You are missing this

Code:

Dim Rng1 As Range, Rng2 As Range
 Set Rng1 = Ws1.Range("A1").CurrentRegion: Set Rng2 = Ws2.Range("A1").CurrentRegion

Missing Rng1 Rng2.JPG : https://imgur.com/pF9JLdC
Missing Rng1 Rng2.JPG

Code:

'1b Ranges
Dim Rng1 As Range, Rng2 As Range
 Set Rng1 = Ws1.Range("A1").CurrentRegion: Set Rng2 = Ws2.Range("A1").CurrentRegion
Dim Rng1A As Range, Rng2B As Range ' , Rng2A As Range
 Set Rng1A = Rng1.Range("A1:A" & Rng1.Rows.Count & ""): Set Rng2B = Rng2.Range("B1:B" & Rng2.Rows.Count & "")  ' : Set Rng2A = Rng2.Range("A1:A" & Rng2.Rows.Count & "")
Rem 2 ..............................

( Note also : It is very bad programming to use On Error Resume Next at the start of a program )

**fixer** · 03-23-2020, 05:51 PM

May i know the reason why it is bad Doc sir So that i can be safe with my work
I have not use this in every code but Now some modification is needed and as per requirement that line is needed but may i know the information Doc sir why i should not use that & what that line will do, it will only stop the Error msg only correct me doc Sir if i am wrong

**fixer** · 03-23-2020, 08:45 PM

No issue Doc Sir i have another plan for this i will not use that line Thnx for the guidance Sir but i am not getting the desired result plz look Sir

**DocAElstein** · 03-23-2020, 08:40 PM

On Error Resume Next is one of a few ways to do “Error handling in VBA” ( http://www.excelfox.com/forum/showth...GoRoT-N0Nula-1 )

On Error Resume Next at the start of your program will tell VBA to keep going even if it crashes or has problems many times.
It is like you go on a long journey in your car. But you decide to drive very fast and if you have lots of crashes and accidents you just keep going very fast and ignore all your accidents and crashes.
This can do damage and break things.

It does not just stop the error message. It does stop the error message , you are correct , … but also it does keep going even if things are broken or not working properly. This might do bad damage. You may not notice this damage until something else goes badly wrong. It may cause lots of confusing problems later.

On Error Resume Next at the start of your program is dangerous. You may be lucky one day and it will cause no problems. Or you may be unlucky and it will cause lots of problems and cause lots of damage.

Usually there is a better way to achieve what you want without Error Handling.

Some ways to use Error handling are not too bad.
For example:

This is very Bad

Code:

Sub BadErrorHandling()
On Error Resume Next ' Error handling is ON
Dim Nmbr As Long: Let Nmbr = 0

'
'  code
''  code
''  code
''  code
''  code
''  code
''  code
''  code
''  code
'

 Let Nmbr = 1 / Nmbr

 '
 '
 '  code
''  code
''  code
''  code
''  code
''  code
'
End Sub

This is not so bad

Code:

Sub NotSoBadErrorHandling()

Dim Nmbr As Long: Let Nmbr = 0

'
'  code
''  code
''  code
''  code
''  code
''  code
''  code
''  code
''  code
'
On Error Resume Next ' Error handling is ON
 Let Nmbr = 1 / Nmbr
On Error GoTo 0      ' Error handling is OFF
 '
 '
 '  code
''  code
''  code
''  code
''  code
''  code
'
End Sub

The last macro is not so bad because you only use the error handling for a short piece of the code which you think may error.

But it is still better to do it without error handling

Code:

Sub AlternativeToErrorHandling()

Dim Nmbr As Long: Let Nmbr = 0

'
'  code
''  code
''  code
''  code
''  code
''  code
''  code
''  code
''  code
'

    If Nmbr <> 0 Then Let Nmbr = 1 / Nmbr

 '
 '
 '  code
''  code
''  code
''  code
''  code
''  code
'
End Sub