2 open workbooks - find 1 delete from other

davie1982

Board Regular
Joined
Nov 19, 2007
Messages
170
Office Version
  1. 365
  2. 2019
Hiya again.

I like this forum as you can tell :P

I have 2 open workbooks. I've picked up the filenames in VB.

One of them is strRemitN

Another one is strStateM

In strRemit i have invoice numbers (OP/I123456) in column A.

in strStateM the invoice numbers are in column C

How would i go around, in VBA, to search for the first invoice number from strRemitN to strStateM, delete the row, then go to the next, all the way to the bottom?

To help with the stuff i've already got... i've worked out the last row.

Dim intLRow as integer
intLRow = Range("A65536").End(xlUp).Row

Can anyone either help me on this or point me in the right direction please?

Thanks.
 

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
Just for clarification, what do you want to do if there is a common invoice number on strRemitN and strStateM?

(a) Delete the row in strRemitN
(b) Delete the row in strStateM
(c) Delete the row in both workbooks

If the answer is (b), the first thing you should do is to find which entries in strStateM are contained in strRemitN. Assuming the invoice numbers in strRemitN are in rows 2 through 8, and the first row of data in strStateM is in row 2, put this formula somewhere on row 2 of strStateM:

=IF(COUNTIF([strRemitN.xls]Sheet1!$A$2:$A$8, C2)>0, 1, 0)

This checks to see if the invoice number on the row is contained in the list of invoice numbers on strRemitN. If it is, it returns 1; otherwise, it returns 0. In my example, I have this formula in cell J2. Copy this formula down.

Now, here is some code to delete the rows where the value in J2 (which contained the formula) is 1. Put this in a module in strStateM:
Code:
Sub CompareDelete()

Dim lngLastRow As Long, i As Long

lngLastRow = Range("C65535").End(xlUp).Row
For i = lngLastRow To 2 Step -1
    If Range("J" & i).Value = 1 Then Rows(i).Delete
Next i

End Sub
 
Upvote 0
Hiya, this works good! except that a part of it is REALLY slow...

This is my code... i'll mark where it's slow :P

Code:
Sub RemitCheck()
Dim lngLastRow As Long, i As Long

Dim str2ndWbName As String
Dim strWBName As String
strWBName = ActiveWorkbook.Name
str2ndWbName = Sheets("code").Range("A4").Formula
Workbooks.Open (Sheets("Code").Range("A1").Formula)

    Windows(str2ndWbName).Activate
Application.ScreenUpdating = False
lngLastRow = Range("A65535").End(xlUp).Row

    Columns("H:H").Select
    Selection.Insert Shift:=xlToRight

    Range("H5").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(COUNTIF('[" & strWBName & "]Remittance'!C1,RC[-5])>0, 1, 0)"
    Range("H5").Select
Selection.AutoFill Destination:=Range("H5:H" & lngLastRow)

Application.ScreenUpdating = True

'Slow here, especially if you got 2000+ invoices on the remittance

For i = lngLastRow To 2 Step -1
    If Range("H" & i).Value = 1 Then Rows(i).Delete
Next i

    Columns("H:H").Select
    Selection.Delete Shift:=xlToLeft

MsgBox prompt:="All invoice from the remit have been taken off of the Statement", _
        Title:="Complete"

End Sub

Although it works good.. are there any other alternatives to get rid of the rows with the 1's in column H?

Thanks

Davie
 
Upvote 0
Remove the Application.ScreenUpdating = True statement. That should speed things up significantly.
 
Upvote 0
naw, that didn't work, i've tested that part already and it still takes the same time (around 9-10 minutes for only 200 rows of data). There must be a quicker way.
 
Upvote 0
I've also noticed that when more than one workbook is open, macros tend to run very slowly. If you try closing out the other workbooks right before doing the row deletions, it might work faster.
 
Upvote 0
Can this be changed so that instead of deleting the invoice from strStateM, it moves them to a different worksheet... say.. "Remitted"?
 
Upvote 0
Sure you can. You would just need to replace this:
Code:
For i = lngLastRow To 2 Step -1
    If Range("H" & i).Value = 1 Then Rows(i).Delete
Next i
with this:
Code:
Dim lngPasteRow as Long
lngPasteRow = 2

For i = 2 to lngLastRow
    If Sheets("Base Sheet").Range("H" & i).Value = 1 Then
        Sheets("Base Sheet").Rows(i).Copy Sheets("Remitted").Rows(lngPasteRow)
        lngPasteRow=lngPasteRow+1
    End If
Next i
Here, Base Sheet is the name of the worksheet that you are going to be copying from, and lngPasteRow is a marker that tells the program where to paste the next row that is a match.
 
Upvote 0
Thanks for that!

There's 1 last question.. how would i check if sheets("Remittance") exists, and if it doesn't, create one?
 
Upvote 0

Forum statistics

Threads
1,213,482
Messages
6,113,916
Members
448,533
Latest member
thietbibeboiwasaco

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top