Need VBA code that will delete rows with certain parameters

[PaigeWarner]

I need VBA coding that will delete rows based on the following Parameters:

ONLY looking at three columns together: Material Number (column J), Old Price (column M) and New Price (column N) and if duplicates, delete extra duplicate rows.

Here is a screen shot of how the file starts out:

And here is a screen shot of how it should end up (the rows that should be left after parameters above):

Here is a copy and paste of the rows and columns:

IDoc number	Partner number	Vendor Name	Purchasing Document	Item	Material Type	Gen. item cat. grp	Mtrl Stock Status	Material Category	Material Number	MIC Number	Material Description	Old Price	New Price	% PriceVariance	Status message
799889375	11121	GHI Incorporated	4703996627	11	HAWA	ZNOR	Stock	02	110104	D567H2	Grill Cleaner	25.70	26.46	2.96	ME730
799889371	11121	GHI Incorporated	4703996626	5	HAWA	ZNOR	Stock	02	110104	D567H3	Grill Cleaner	25.70	27.46	2.96	ME730
799888572	11121	GHI Incorporated	4703996624	1	HAWA	ZNOR	Stock	02	110104	D567H4	Grill Cleaner	25.70	26.46	2.96	ME728
799889377	11121	GHI Incorporated	5103996622	2	HAWA	ZNOR	Stock	02	110104	D567H5	Grill Cleaner	25.70	26.46	2.96	ME730
799925395	31415	JKL Incorporated	4703996431	21	HAWA	ZNOR	Stock	14	119219	J1313RN	Ice Bucket	8.83	9.06	2.60	ME730
799922758	31415	JKL Incorporated	4703996430	22	HAWA	ZNOR	Stock	14	119219	J1313RN	Ice Bucket	8.83	9.06	2.60	ME730
799679315	31415	JKL Incorporated	4703996427	8	HAWA	ZNOR	Stock	14	119219	J1313RN	Ice Bucket	8.83	9.06	2.60	ME730
799752589	31415	JKL Incorporated	4703996424	22	HAWA	ZNOR	Stock	14	119219	J1313RN	Ice Bucket	8.83	9.06	2.60	ME728
799925399	31415	JKL Incorporated	5103996421	8	HAWA	ZNOR	Stock	14	119219	J1313RN	Ice Bucket	8.83	9.06	2.60	ME730
799648832	16171	MNO Incorporated	4703996046	3	HAWA	ZNOR	Stock	14	137148	27YH3R	Landry Detergent	117.64	135.70	15.35	ME730
799648832	16171	MNO Incorporated	4703996046	5	ZSPC	ZNOR	Stock	14	137153	28YH3R	Water Tank	180.83	207.44	14.72	ME730
799648832	16171	MNO Incorporated	3003996046	11	ZSPC	ZNOR	Stock	14	137165	29YH3R	Floor Cleaner	113.88	141.34	24.11	ME730
799648832	16171	MNO Incorporated	4703996046	12	HAWA	ZNOR	Stock	14	137168	30YH3R	Blender	208.01	222.20	6.82	ME730
799648832	16171	MNO Incorporated	4703996046	2	HAWA	ZNOR	Stock	14	137177	26YH3R	Dish Soap	101.84	109.48	7.50	ME790
800018928	67891	DEF Incorporated	4703996590	1	ZSPC	ZBN3	Non Stock	24	443217	H2312P	Faucet Handle	38.34	40.25	4.98	ME730

Thank you in advance for any assistance you can provide!

 

[kanadaaa]

It was hard to write a code for this than I initially thought...
The code below only checks column J to see if there're duplicates in it but does get you the result you need.

Sub DeleteRowsWithDuplicateMaterialNumber()

    'Get all material numbers
    Dim d As Object, lr As Long, i As Long
    Set d = CreateObject("Scripting.Dictionary")
    lr = Range("J" & Rows.Count).End(xlUp).Row
  
    For i = 2 To lr
        d.Item(Cells(i, "J").Value) = 1
    Next i
  
    'Get duplicate material numbers
    Dim dupVals() As String, j As Long
  
    For i = 0 To d.Count - 1
        If WorksheetFunction.CountIf(Cells(2, "J").Resize(lr - 2), d.keys()(i)) > 1 Then
            ReDim Preserve dupVals(j)
            dupVals(j) = d.keys()(i)
            j = j + 1
        End If
    Next i
  
    'Get row numbers with duplicates
    Dim rng As Range, tempRng As Range, rowsToDelete() As String
  
    j = 0
    For i = LBound(dupVals) To UBound(dupVals)
        Set rng = Range("J:J").Find(What:=dupVals(i), LookAt:=xlWhole)
        Set tempRng = rng
        Do While Not rng Is Nothing
            If rng.Address <> tempRng.Address Then
                ReDim Preserve rowsToDelete(j)
                rowsToDelete(j) = rng.Row
                j = j + 1
            End If
            Set rng = Range("J:J").FindNext(rng)
            If rng.Address = tempRng.Address Then Exit Do
        Loop
    Next i
  
    'Delete rows with duplicates
    Application.ScreenUpdating = False
    For i = UBound(rowsToDelete) To LBound(rowsToDelete) Step -1
        Rows(rowsToDelete(i)).Delete
    Next i
    Application.ScreenUpdating = True
  
End Sub

 

[Fluff]

@kanadaaa The OP is using a Mac, so cannot use the Scripting.Dictionary.

 

[kanadaaa]

@kanadaaa The OP is using a Mac, so cannot use the Scripting.Dictionary.

Oops I was totally unaware of his/her OS

 

[PaigeWarner]

Thank you so much!

 

[kanadaaa]

For Mac OS, without Scripting.Dictionary

Sub DeleteRowsWithDuplicateMaterialNumber() 'MacVer

    'Get all material numbers
    Dim lr As Long, i As Long, mNums() As Long, j As Long
    lr = Range("J" & Rows.Count).End(xlUp).Row

    For i = 2 To lr
        If IsInArray(Cells(i, "J").Value, mNums) = False Then
            ReDim Preserve mNums(j)
            mNums(j) = Cells(i, "J").Value
            j = j + 1
        End If
    Next i
    
    'Get duplicate material numbers
    Dim dupVals() As String
    
    j = 0
    For i = LBound(mNums) To UBound(mNums)
        If WorksheetFunction.CountIf(Cells(2, "J").Resize(lr - 2), mNums(i)) > 1 Then
            ReDim Preserve dupVals(j)
            dupVals(j) = mNums(i)
            j = j + 1
        End If
    Next i
    
    'Get row numbers with duplicates
    Dim rng As Range, tempRng As Range, rowsToDelete() As String
    
    j = 0
    For i = LBound(dupVals) To UBound(dupVals)
        Set rng = Range("J:J").Find(What:=dupVals(i), LookAt:=xlWhole)
        Set tempRng = rng
        Do While Not rng Is Nothing
            If rng.Address <> tempRng.Address Then
                ReDim Preserve rowsToDelete(j)
                rowsToDelete(j) = rng.Row
                j = j + 1
            End If
            Set rng = Range("J:J").FindNext(rng)
            If rng.Address = tempRng.Address Then Exit Do
        Loop
    Next i
    
    'Delete rows with duplicates
    Application.ScreenUpdating = False
    For i = UBound(rowsToDelete) To LBound(rowsToDelete) Step -1
        Rows(rowsToDelete(i)).Delete
    Next i
    Application.ScreenUpdating = True
    
End Sub

Function IsInArray(valToBeFound As String, arr As Variant) As Boolean
    Dim el As Variant
    
    On Error GoTo IsInArrayError: 'array is empty
    For Each el In arr
        If el = valToBeFound Then
            IsInArray = True
            Exit Function
        End If
    Next el
Exit Function
IsInArrayError:
    On Error GoTo 0
    IsInArray = False
    
End Function

 

[PaigeWarner]

This specific code was for my work PC, so thank you again!