Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Finding Matching Data on Another Sheet
On May 15, 6:22 pm, merjet wrote:
http://groups.google.com/group/micro...rogramming/bro... Hth, Merjet Merjet: Thanks again, it took me a while to understand exactly what you gave me (probably because I'm a bit thick :-) ), but here's what I came up with. It works like a charm! Private Sub WashLeads() 'Note: EndRow is calculated by counting the number of cells with a Company Name in it ' and is initialized in the main procedure. This takes into account any leads ' that may not have a DUNS number in the data. Dim c1 As Range 'DUNS Number as listed on Working Copy Dim c2 As Range 'DUNS Number as listed on Wash List Dim c3 As Range 'Washed Leads cell where washed lead will be pasted Dim rng1 As Range 'List of DUNS Numbers from Working Copy Dim rng2 As Range 'List of DUNS Numbers from Wash List Dim iRow As Long 'Row counter for looping purposes Dim MyRow As Range 'Row on Working Copy that will be moved to the Washed Leads sheet Dim StartRow As Long 'Row where deletion from Working Copy will start Dim CalcMode As Long Dim ViewMode As Long 'Initialize the ranges to be compared With Worksheets("Working Copy") Set rng1 = .Range("M2", .Cells(EndRow, 13)) End With With Worksheets("Wash List") Set rng2 = .Range("B2", .Cells(EndRow, 2)) End With 'Create a new worksheet to place any leads that were washed ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count) ActiveSheet.Name = "Washed Leads" Set c3 = Worksheets("Working Copy").Range("A1") 'Set the header row on the new worksheet With Worksheets("Working Copy") Set MyRow = c3.EntireRow MyRow.Copy Destination:=Worksheets("Washed Leads").Range("A1") End With With Worksheets("Washed Leads").Range("AC1") .Value = "Client ID Lead Duplicates" .Font.Bold = True End With 'Loop through the cells in each range and compare the DUNS number values 'If match, flag matches by changing font to red on the Working Copy data Set c3 = ActiveSheet.Range("A2") For Each c1 In rng1 For Each c2 In rng2 If c1.Value = c2.Value Then iRow = iRow + 1 Set MyRow = c1.EntireRow Set c3 = ActiveSheet.Range("A2") c3.Offset(iRow).Activate MyRow.Copy Destination:=c3(iRow) MyRow.Font.Color = RGB(255, 0, 0) c2.Offset(0, -1).Resize(1, 1).Copy Destination:=c3.Cells(iRow, 29) End If Next c2 Next c1 'Delete any borders and make the columns wide enough to display all data Cells.Select Cells.EntireColumn.AutoFit Cells.Borders.LineStyle = xlLineStyleNone ActiveSheet.Range("A1").Select 'Loop through the records on the Working Copy worksheet and delete 'any rows with red font color. Worksheets("Working Copy").Activate With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False End With ViewMode = ActiveWindow.View ActiveWindow.View = xlNormalView With ActiveSheet .DisplayPageBreaks = False StartRow = 2 For iRow = EndRow To StartRow Step -1 If IsError(.Cells(iRow, "A").Value) Then 'Do nothing, This avoids a error if there is a error in the cell ElseIf .Cells(iRow, "A").Font.Color = RGB(255, 0, 0) Then .Rows(iRow).Delete 'This will delete each row with red font color. End If Next End With ActiveWindow.View = ViewMode With Application .ScreenUpdating = True .Calculation = CalcMode End With End Sub Jana |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Finding Matching Data on Another Sheet
Thanks again, it took me a while to understand exactly what you gave
me (probably because I'm a bit thick :-) ), but here's what I came up with. It works like a charm! Excellent, and you probably learned some things you will find useful in the future. Cheers, Merjet |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Matching data from one sheet to another | New Users to Excel | |||
vlookup not finding matching data | Excel Worksheet Functions | |||
Finding matching cell data | Excel Worksheet Functions | |||
List matching data from sheet 1 in sheet 2 | Excel Worksheet Functions | |||
Importing and Finding Matching data | Excel Programming |