Finding matching rows on two worksheets

[Wire323]

I'm trying to compare rows on 2 worksheets. If there are matches then I want to take the rows off of the 1st worksheet and move it to a 3rd one.

My 1st worksheet consists of "admin calls." Column A is the phone number, H is the date, and F is the start time.

My 2nd worksheet consists of "all calls." Column I is the phone, B is the date, and C is the start time.

I want to look at each row of the 1st worksheet, and try to find a matching row on the 2nd. A match will mean the phone number, date, and start time are all the same. If it finds a match, then I want to copy the value of Column B on the 1st worksheet to COlumn M on the 2nd. I'll then take the row off of the 1st worksheet and move it to a 3rd worksheet (called "matches").

Any help will be greatly appreciated. This is the last piece of a project I'm working on to make our billing girl's life a lot easier.


If I need to explain anything better then please let me know. I'm posting this question in a few different forums.

Thanks.

 

[HalfAce]

You're most welcome. Glad it helped.
Good job with the amendments too. Although if you want to actually remove the rows instead of just copying them we really should loop up through the range from the bottom instead of down from the top. (That way if you have two consecutive rows that need to be deleted they'll both be gone.)
I don't really have time to rewrite it at the moment but I'll see if I can get a chance in a little bit.
I'll think about how we can deal with the times also. There might be something we can do about that as well.
(Gotta keep the billing girl happy, right? )

 

[Wire323]

It worked out pretty well so far. To give you an idea, my Sheet2 has probably 7,000 rows. The 2 sheets I'm looking for matches on have a total of 2200 records. It took almost 10 minutes for my laptop to finish the macro.

Out of the 2200 records, I was left with about 900 (and 1300 matches). That's pretty good, but I know it would be more accurate if I converted the numbers to times then compared them (+/- 15 minutes). I would have to convert them back over to numbers afterwords, but I had to format the times to match Sheet2 so I already have the code for that:

Dim c As Range
    For Each c In Selection
       If c.NumberFormat = "h:mm" Then
            If IsNumeric(c) Then
                c = Val(Format(c, "hhmm"))
                c.NumberFormat = "General"
            End If
        End If     
    Next

And yes, the billing girl will be happy. I can't wait to see her face when she walks in tomorrow and I show her what I have so far. She takes 4-5 days each month to do everything manually right now. I'm trying to make that tedious time as short as possible (and more accurate).

 

[HalfAce]

Wow. 10 minutes seems like a long time but I guess it beats 4 or 5 days. Not to mention having to do that many rows manually!
(That girl deserves a raise! )

Here's a way to delete all the offending rows in sheet1 without having to rewrite the code to loop up from the bottom. We can just make VBA remember where each row is while it's copying them and then delete the whole lot of them at once when it's done with the loop.

Option Explicit
Sub FindMatchesDemo2()
Dim Rng1 As Range, Rng2 As Range, DltRng As Range
Dim c1 As Range, c2 As Range

With Sheets("Sheet1")
    Set Rng1 = Range(.Cells(2, "A"), .Cells(Rows.Count, "A").End(xlUp))
End With
With Sheets("Sheet2")
    Set Rng2 = Range(.Cells(2, "I"), .Cells(Rows.Count, "I").End(xlUp))
End With
For Each c2 In Rng2
    For Each c1 In Rng1
        If c1 = c2 _
        And c1.Offset(, 5) = c2.Offset(, -6) _
        And c1.Offset(, 7) = c2.Offset(, -7) Then
            c2.Offset(, 4) = c1.Offset(, 1)
            c1.EntireRow.Copy _
                Sheets("matches").Cells(Rows.Count, "A").End(xlUp)(2, 1)
            If DltRng Is Nothing Then
                Set DltRng = c1
            Else
                Set DltRng = Union(c1, DltRng)
            End If
        End If
    Next c1
Next c2
If Not DltRng Is Nothing Then DltRng.EntireRow.Delete Shift:=xlUp
End Sub

I haven't played with the time formatting code.
Do you have that figured out, or would you like a hand with that as well?

 

[Wire323]

I haven't had a chance to work on the time part. I've been getting caught up on other stuff I have to do.

If you wouldn't mind giving me a hand I'd appreciate it. If I could somehow send you a beer once this is through I would.

I'm learning a lot with this little project. I've done programming in the past, but I'm pretty new to VBA and its syntax. I mainly do a lot of database work and remote network administration (along with whatever else they throw at me here at work).

 

[011]

plz help me
i have an excel file with f.e 2 sheets
every sheet contains data of people in different formats (there ixists also time formats)
Iwant to create the third sheet that find similar names and summarize the data .IT also may be so that one person exist in the first sheet and doesn't ixist in the second one .
Thans beforehand for any assistance.

 

[HalfAce]

Good morning Wire323,
Had a few minutes to play with the code again and this seems to do what I think your after. (Works with the limited testing I can do here anyway.)
What it'll do now is convert all the values in columns F of sheet1 and C of sheet2 from a #### format to a hh:mm format.
Then it'll make the comparisons and consider a match to be the phone numbers, the dates and any times that are + or - 15 minutes of eachother.
After that it'll go back & return the time columns formatting to ####.

It'll likely add a bit more time to the entire routine as we're looping through the time columns now also, but I figure the time it takes is being compared to 4 days or better, so that gives us a lot of elbow room, eh?
I've turned off the screen updating throughout the process to help speed it up a touch too.
When you get a chance, how about giving this a try and see if I've captured your intent correctly.

Sub FindMatchesDemo3()
Dim Rng1 As Range, Rng2 As Range, DltRng As Range
Dim c1 As Range, c2 As Range
Application.ScreenUpdating = False

With Sheets("Sheet1")
    Set Rng1 = Range(.Cells(2, "F"), .Cells(Rows.Count, "F").End(xlUp))
End With
For Each c1 In Rng1
   If Not c1.NumberFormat = "h:mm" Then
        If IsNumeric(c1) Then c1 = Format(c1, "##:##")
    End If

Next c1
With Sheets("Sheet1")
    Set Rng1 = Range(.Cells(2, "A"), .Cells(Rows.Count, "A").End(xlUp))
End With

With Sheets("Sheet2")
    Set Rng2 = Range(.Cells(2, "C"), .Cells(Rows.Count, "C").End(xlUp))
End With
For Each c2 In Rng2
   If Not c2.NumberFormat = "h:mm" Then
        If IsNumeric(c2) Then c2 = Format(c2, "##:##")
    End If
Next c2
With Sheets("Sheet2")
    Set Rng2 = Range(.Cells(2, "I"), .Cells(Rows.Count, "I").End(xlUp))
End With

For Each c2 In Rng2
    For Each c1 In Rng1
        If c1 = c2 _
        And Not c1.Offset(, 5) < c2.Offset(, -6) - 0.010117 _
        And Not c1.Offset(, 5) > c2.Offset(, -6) + 0.010117 _
        And c1.Offset(, 7) = c2.Offset(, -7) Then
            c2.Offset(, 4) = c1.Offset(, 1)
            c1.EntireRow.Copy _
                Sheets("matches").Cells(Rows.Count, "A").End(xlUp)(2, 1)
            If DltRng Is Nothing Then
                Set DltRng = c1
            Else
                Set DltRng = Union(c1, DltRng)
            End If
        End If
    Next c1
Next c2

If Not DltRng Is Nothing Then DltRng.EntireRow.Delete Shift:=xlUp

With Sheets("Sheet1")
    Set Rng1 = Range(.Cells(2, "F"), .Cells(Rows.Count, "F").End(xlUp))
End With
For Each c1 In Rng1
   If c1.NumberFormat = "h:mm" Then
        If IsNumeric(c1) Then
            c1 = Val(Format(c1, "hhmm"))
            c1.NumberFormat = "General"
        End If
    End If
Next

With Sheets("Sheet2")
    Set Rng2 = Range(.Cells(2, "C"), .Cells(Rows.Count, "C").End(xlUp))
End With
For Each c2 In Rng2
   If c2.NumberFormat = "h:mm" Then
        If IsNumeric(c2) Then
            c2 = Val(Format(c2, "hhmm"))
            c2.NumberFormat = "General"
        End If
    End If
Next

Application.ScreenUpdating = True
End Sub

Hope it helps.


[EDIT:]
Hello 011, and welcome to the board.
I'm sorry I can't help you with your question but I don't have a very clear picture of what you're asking.
You will be better served if you start a new thread (with a more clear explanation) as more people will see it and be able to respond.

 

[Wire323]

Looks great!

I'll try it out and let you know how it does.

 

[Wire323]

I get a "Type Mismatch," and it highlights this code:

 If c1 = c2 _
            And Not c1.Offset(, 5) < c2.Offset(, -6) - 0.010117 _
            And Not c1.Offset(, 5) > c2.Offset(, -6) + 0.010117 _
            And c1.Offset(, 7) = c2.Offset(, -7) Then

 

[Krishnakumar]

Hi,

See this

 

[Wire323]

I tried yours, but it opens up a save file box. When I close it all of the data is gone on the "Admin Calls" sheet, and all of the cells in the first row have dropdown boxes for sorting.

I'm not sure what might be wrong with it.

HalfAce has given me an example that works really well. The last little part I'm trying to work out is comparing times (+/- 15 minutes).