finding first value in column that matches a value in range

Mark_G

Board Regular
Joined
Aug 6, 2004
Messages
123
Hello,

I am currently trying to sort a portion of my data, and this sort will be based on the values in one of the columns. The reason for this sort is I am trying to delete duplicates, but only those that are duplicates from the past 14 days. So each day new data is loaded into the master file, and the macro is run, and if there is duplicate entries within the past 14 days, the row or rows with the newest entry is deleted. If there is a duplicate entry but the original entry is more than 14 days old, the duplicate is not deleted.

I was thinking that the sort would allow me to do this as the duplicates would not be above each other, so the it should work(maybe not as I may have missed something).

I am having trouble with the finding the row for the start of the range. The macro needs to look at the range P2:P & LR and find the first value that matches any of the values in the range T1:T14. Is this possible.

Code:
Sub ImportSample()
'
' ImportSample Macro
' Macro written 12/10/2006 by Mark Gillis
'

'
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim RowNdx As Long

Set wb1 = ActiveWorkbook

   
ChDrive "C:\"
ChDir "C:\Documents and Settings\All Users\Desktop\"
Filt = "Excel Files (*.xls), *.xls"
FilterIndex = 5
Title = "Please select the file with the sample to import"
Filename = Application.GetOpenFilename(FileFilter:=Filt, _
    FilterIndex:=FilterIndex, Title:=Title)
If Filename = False Then
    Response = MsgBox("No File was selected", vbOKOnly & vbCritical, "Selection Error")
        Exit Sub
End If
Response = MsgBox("You selected " & Filename, vbInformation, "Proceed")
Workbooks.Open Filename

Set wb2 = ActiveWorkbook

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
    
LR = Sheets("Received").Range("C65536").End(xlUp).Row
    
    Columns("F:F").Cut
    Columns("A:A").Insert Shift:=xlToRight
    Columns("B:C").Insert Shift:=xlToRight
    Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(3, 1), Array(6, 1)), TrailingMinusNumbers:= _
        True
    Columns("D:D").Insert Shift:=xlToRight
    Columns("E:E").Cut
    Columns("H:H").Insert Shift:=xlToRight
    Columns("F:F").Cut
    Columns("E:E").Insert Shift:=xlToRight
    
Range("D2:D" & LR).FormulaR1C1 = _
        "=IF(OR(RC[7]=""BC"",RC[7]=""AB""),1,IF(OR(RC[7]=""SK"",RC[7]=""MB"",RC[7]=""NB"",RC[7]=""NS"",RC[7]=""PE"",RC[7]=""NF""),2,IF(RC[7]=""ON"",3,IF(RC[7]=""QC"",4))))"
Range("N2:N" & LR).FormulaR1C1 = "=TODAY()"
Range("N:N").NumberFormat = "dd/mmm/yy"
Range("P2:P" & LR).FormulaR1C1 = "=IF(R[-1]C=""ORIGORDER"",1,R[-1]C+1)"
Range("O2:O" & LR).FormulaR1C1 = "=IF(RC[-1]-R1C18=-1,0,RC[-1]-R1C18)"
Columns("O:O").NumberFormat = "0"


Range("A2:R" & LR).Copy

wb1.Activate
LR1 = Sheets("LoadToDash").Range("E65536").End(xlUp).Row

Range("A" & LR1 + 1).PasteSpecial
wb2.Close

Range("R1").FormulaR1C1 = "=MIN(C[-4])"
Range("R1").NumberFormat = "dd/mmm/yy"
Range("S1").FormulaR1C1 = "=MAX(C[-4])"
Range("S2:S14").FormulaR1C1 = "=R[-1]C[-1]-1"
Range("N:N").NumberFormat = "dd/mmm/yy"
Columns("O:O").NumberFormat = "0"

LR2 = Sheets("LoadToDash").Range("E65536").End(xlUp).Row
Columns("G:G").Insert Shift:=xlToRight
Range("G2:G" & LR2).FormulaR1C1 = "=RC[-2]&"" ""&RC[-1]"

Columns("A:S").AutoFit
Rows("1" & LR2).AutoFit

Application.Calculation = xlCalculationAutomatic
Range("A1:T" & LR2).Copy
Range("A1").PasteSpecial Paste:=xlPasteValues, SkipBlanks:=True
Application.Calculation = xlCalculationManual

Range("A2:R" & LR2).Sort Key1:=Range("P1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1


FR = Range("P2:P" & LR2).Find(what:=Range("T1:T14").Value, lookat:=xlWhole)

    Range("A" & FR & ":S" & LR2).Sort Key1:=Range("I1"), Order1:=xlAscending, Key2:=Range("P1") _
            , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1
    
    For RowNdx = Range("I1").End(xlDown).Row To 2 Step -1
        If Cells(RowNdx, "I").Value = Cells(RowNdx - 1, "I").Value Then
            If Cells(RowNdx, "P").Value <= Cells(RowNdx - 1, "P").Value Then
                Rows(RowNdx).Delete
            Else
                Rows(RowNdx - 1).Delete
            End If
        End If
    Next RowNdx

    Range("A" & FR & ":S" & LR2).Sort Key1:=Range("G1"), Order1:=xlAscending, Key2:=Range("P1") _
            , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1
    
    For RowNdx = Range("G1").End(xlDown).Row To 2 Step -1
        If Cells(RowNdx, "G").Value = Cells(RowNdx - 1, "G").Value Then
            If Cells(RowNdx, "P").Value <= Cells(RowNdx - 1, "P").Value Then
                Rows(RowNdx).Delete
            Else
                Rows(RowNdx - 1).Delete
            End If
        End If
    Next RowNdx

Columns("R:T").Delete
Columns("G:G").Delete

Range("A2:R" & LR2).Sort Key1:=Range("P1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True

ChDir "C:\Documents and Settings\All Users\Desktop\"
Filt = "Excel Files (*.xls), *.xls"
FilterIndex = 5
Title = "Please select a file location and file name to save file as"
Filename = Application.GetSaveAsFilename(FileFilter:=Filt, _
    FilterIndex:=FilterIndex, Title:=Title)
If Filename = False Then
    Response = MsgBox("No File was selected", vbOKOnly & vbCritical, "Selection Error")
    Exit Sub
End If
Response = MsgBox("You selected " & Filename, vbInformation, "Proceed")
ThisWorkbook.SaveAs Filename

End Sub

As you can probably tell, I have been able to find various bits of code to do what I need, it is just the search I am having trouble with.

If none of this makes sense, let me know and I can paste up a sample.

Thanks

Mark
 

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.

Forum statistics

Threads
1,136,305
Messages
5,674,984
Members
419,541
Latest member
freddyboots

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
Top