PDA

View Full Version : [SOLVED] Find unique records between 2 sheets and delete



Robinsper
01-22-2017, 09:27 PM
I'm working on a long application and I hit a wall trying to find unique records between 2 sheets and removing the row from the first sheet if the record doesn't exist in the second sheet. Here's the code I have for this section of my program, I'm a bit confuse as to how to accomplish this and I'm hoping someone will be willing to take a look and give me some suggestions, thanks.
*Explanation:
I'm looking for the unique records in column B and I'll be searching over 3000 cells in that column. If the records exist in sheet 1 but not in sheet 2 they should be deleted.





Option Explicit

Sub RemoveReversionItems()
Dim wbook As Workbook, Wsheet As Worksheet, wbName As String, wsName As String
Dim AlphaRange As Range, ReversionRange As Range
Dim AlphaArray
Dim ReversionArray
Dim x As Long
Dim AlphaSheetColumn As String: AlphaSheetColumn = "B" 'The column with the PO#
Dim ReversionSheetColumn As String: ReversionSheetColumn = "B" 'The column with the PO#


For Each wbook In Workbooks
If wbook.Name <> ActiveWorkbook.Name Then wbName = wbook.Name
Workbooks(wbName).Activate

'********************************
' Look for Reversion Queue
'********************************

For Each Wsheet In wbook.Worksheets
wsName = Wsheet.Name
If Wsheet.Name Like "Revers*" Then
MsgBox "This workbook is named " & wbName & " The Sheet is " & wsName
'Get Reversion Range
With Sheets(wsName)
Set ReversionRange = .Range(.Range(ReversionSheetColumn & "2"), _
.Range(ReversionSheetColumn & rows.Count).End(xlUp))
ReversionArray = ReversionRange
End With
End If
Next Wsheet


'*****************************
' Look for Alpha Queue
'*****************************

For Each Wsheet In wbook.Worksheets
wsName = Wsheet.Name
If Wsheet.Name Like "PO_LN*" Then
'Load Alpha WorkSheet array
With Sheets(wsName)
Set AlphaRange = .Range(.Range(AlphaSheetColumn & "2"), _
.Range(AlphaSheetColumn & rows.Count).End(xlUp))
AlphaArray = AlphaRange
End With

MsgBox "This workbook is named " & wbName & " The Sheet is " & wsName
End If
Next Wsheet

If IsArray(ReversionArray) Then
For x = UBound(ReversionArray) To 1 Step -1
If AlphaArray <> ReversionArray(x, 2) Then
ReversionRange.Cells(x).EntireRow.Interior.Color = 255 'I'll change this to delete

End If
Next
Else
End If
Next wbook


End Sub

Paul_Hossler
01-23-2017, 09:09 AM
I'd do it a little differently.

I think the arrays might be an unnecessary complication

Since there was no sample workbook attached with data to test with (yes, that is a hint) this is not tested, but it might give you ideas

I wasn't sure what you were calling Sheet1 and Sheet2 so I made an assumption




Option Explicit

Sub RemoveReversionItems()
Dim wbook As Workbook
Dim wsheet As Worksheet, wsRevers As Worksheet, wsPO_LN As Worksheet
Dim AlphaRange As Range, ReversionRange As Range, rCell As Range
Dim x As Long


For Each wbook In Workbooks

If wbook Is ActiveWorkbook Then GoTo GetNextWorkbook

wbook.Activate

Set wsRevers = Nothing
Set wsPO_LN = Nothing

For Each wsheet In wbook.Worksheets
If wsheet.Name Like "Revers*" Then
Set wsRevers = wsheet
ElseIf wsheet.Name Like "PO_LN*" Then
Set wsPO_LN = wsheet
End If
Next

If wsRevers Is Nothing Then
MsgBox "This workbook is named " & wbook.Name & " but there is no Sheet like 'Revers*'"
GoTo GetNextWorkbook
Else
MsgBox "This workbook is named " & wbook.Name & " The Revers Sheet is " & wsRevers.Name

Set ReversionRange = wsRevers.Cells(2, 2)
Set ReversionRange = Range(ReversionRange, ReversionRange.End(xlDown))
End If

If wsPO_LN Is Nothing Then
MsgBox "This workbook is named " & wbook.Name & " but there is no Sheet like 'wsPO_LN*'"
GoTo GetNextWorkbook
Else
MsgBox "This workbook is named " & wbook.Name & " The wsPO_LN Sheet is " & wsPO_LN.Name

Set AlphaRange = wsPO_LN.Cells(2, 2)
Set AlphaRange = Range(AlphaRange, AlphaRange.End(xlDown))
End If


'"If the records exist in sheet 1 but not in sheet 2 they should be deleted." is ambigious <<<<<<<<<<<<<<<<
' since I don't know which is Sheet1
'Making assumption that
' If Col B value in Revers is NOT in Col B in LN_PO, then delete the Revers row <<<<<<<<<<<<<<<<<<<<<<<

For Each rCell In ReversionRange.Cells
x = -1
On Error Resume Next
x = Application.WorksheetFunction.Match(rCell, AlphaRange, 0)
On Error GoTo 0

If x = -1 Then
rCell.Interior.Color = vbRed 'I'll change this to delete
'UNCOMMENT rCell.value = true
End If
Next
On Error Resume Next
'UNCOMMENT ReversionRange.SpecialCells(xlCellTypeConstants, xlLogical).EntireRow.Delete
On Error GoTo 0

GetNextWorkbook:
Next wbook

End Sub

Robinsper
01-23-2017, 10:18 AM
Hi Paul, I have no words to express how grateful I am, I've been racking my brain trying to figure this out and you nailed it. I wanted to attach a sample sheet which I've been using for testing, but the forum doesn't allow me to, I think it might be because I'm a new member, however, I'm including screenshots to give you an idea. Thank you for taking your valuable time to help me with this.

1810718109

Paul_Hossler
01-23-2017, 11:38 AM
If it does what you want, you can use the [Thread Tools] menu about your first post to make it Solved

If it doesn't, let me know and I'll build a WB with your data and see