Copy whole row across workbooks based on multiple criteria

Question

piecing together bits of code i found and i have two options that both give me errors. I know the answer is obvious but i can't seem to find it...

Error always appears on the "IF" code line on debugger, usually on "_Global" mismatch or etc.

Search for a match in a different workbook based on 3 criteria. if all three are a match then copy the whole row to the next available row in the current workbook.

There could be zero matches or there could be many on a given run (that's why there is that "no wins this week"). also it would be nice when i run this that it writes over the saved results of last time. (i can deal with that later).

"wk1" is a forumla in a cell that give the week number based on =today()-14

my headers for columns on destination worksheet are on row 3. data to check in other workbook starts on row 2. Data to check is column A:AN, row2 to end ('000s).

Suggestion 1, lngLoop:

Sub WinsUpdate()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim wb1 As Workbook, wb2 As Workbook
Dim lngLoop As Long
    lngLoop = 1
Application.ScreenUpdating = False
Set wb1 = Workbooks("Weekly Sales Dashboard")
Set wb2 = Workbooks("Monday Sales Meeting Data")
Set ws1 = wb1.Sheets("Roll_12")
Set ws2 = wb2.Sheets("Sales Weekly Wins")
Set wk1 = ws2.Range("C2")
With Workbooks("Weekly Sales Dashboard").Worksheets("Roll_12")
    For lngLoop = 1 To Rows.Count
    If Cells(lngLoop, 5).Value = "USA - Chicago" And Cells(lngLoop, 9).Value = "Closed/Won" And Cells(lngLoop, 18).Value = wk1 Then
        .EntireRow.Copy Destination:=ws2.Range("A:A" & Rows.Count).End(xlUp).Offset(1)
        Else: ws2.Range("F1") = "No wins this week"
    End If
    Next lngLoop
End With
Application.ScreenUpdating = True
End Sub

Suggestion 2:

Sub WinsUpdate()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim wb1 As Workbook, wb2 As Workbook
Application.ScreenUpdating = False
Set wb1 = Workbooks("Weekly Sales Dashboard")
Set wb2 = Workbooks("Monday Sales Meeting Data")
Set ws1 = wb1.Sheets("Roll_12")
Set ws2 = wb2.Sheets("Sales Weekly Wins")
Set wk1 = ws2.Range("C2")
With Workbooks("Weekly Sales Dashboard").Worksheets("Roll_12")
    If Range("E:E").Value = "USA - Chicago" And Range("L:L").Value = "Closed/Won" And Range("R:R").Value = wk1 Then
        .EntireRow.Copy Destination:=ws2.Range("A:A" & Rows.Count).End(xlUp).Offset(1)
        Else: ws2.Range("F1") = "No wins this week"
    End If
End With
Application.ScreenUpdating = True
End Sub

See if the problem goes away when you qualify which worksheets `Cells`, `Range`, `Rows`, etc refer to. By default they refer to the active worksheet. (And a `With Worksheets("x")` block does not make "x" the active sheet! It's just a shortcut so that you can type `.` instead of `Worksheets("x").`) And I don't think `Workbooks("Weekly Sales Dashboard").Worksheets("Roll_12").EntireRow` will be valid either - it's probably meant to be `Workbooks("Weekly Sales Dashboard").Worksheets("Roll_12").Rows(lngLoop).EntireRow` (which can be shortcutted to `.Rows(lngLoop).EntireRow`). — YowE3K, Dec 28 '16 at 00:50
Oh - just saw your display name - does that imply that "Ian" is your actual name? That's an exceptionally good name!! ;) — YowE3K, Dec 28 '16 at 01:05
haha thank you! i hate coming up with usernames... so many to keep track of.. i got the code to work thanks to Yow. appreciate the help! — IFianTHENdisplayname, Dec 28 '16 at 18:01
Since you all were so helpful on this, maybe you want to help on a real puzzler i have open on another thread for another sheet on this workbook... @YowE3K [link] http://stackoverflow.com/questions/41214271/look-up-match-then-multiply-across-tabs-and-replace-active-cell/41226789?noredirect=1#comment69833128_41226789 — IFianTHENdisplayname, Dec 28 '16 at 18:04

YowE3K · Answer 1 · 2016-12-28T18:44:34.457

Try the following as a replacement for your "Suggestion 1":

Sub WinsUpdate()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim wb1 As Workbook, wb2 As Workbook
    Dim lngLoop As Long
    lngLoop = 1
    Application.ScreenUpdating = False
    Set wb1 = Workbooks("Weekly Sales Dashboard")
    Set wb2 = Workbooks("Monday Sales Meeting Data")
    Set ws1 = wb1.Sheets("Roll_12")
    Set ws2 = wb2.Sheets("Sales Weekly Wins")
    Set wk1 = ws2.Range("C2")
    With Workbooks("Weekly Sales Dashboard").Worksheets("Roll_12")
        For lngLoop = 2 To .Cells(.Rows.Count, 5).End(xlUp).Row ' Changed to avoid looking at a million rows
            If .Cells(lngLoop, 5).Value = "USA - Chicago" And _
               .Cells(lngLoop, 9).Value = "Closed/Won" And _
               .Cells(lngLoop, 18).Value = wk1 Then
                .Rows(lngLoop).EntireRow.Copy Destination:=ws2.Range("A" & ws2.Rows.Count).End(xlUp).Offset(1)
            Else
                ws2.Range("F1") = "No wins this week"
            End If
        Next lngLoop
    End With
    Application.ScreenUpdating = True
End Sub

I am guessing that the Cells, etc, inside your With block were meant to refer to the worksheet named in the With block. If that's not the case, you should correctly qualify them with the worksheet that they do refer to.

Edit to stop "No wins this week" showing except when no rows satisfy criteria:

Sub WinsUpdate()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim wb1 As Workbook, wb2 As Workbook
    Dim lngLoop As Long
    Dim WinFound as Boolean
    lngLoop = 1
    Application.ScreenUpdating = False
    Set wb1 = Workbooks("Weekly Sales Dashboard")
    Set wb2 = Workbooks("Monday Sales Meeting Data")
    Set ws1 = wb1.Sheets("Roll_12")
    Set ws2 = wb2.Sheets("Sales Weekly Wins")
    Set wk1 = ws2.Range("C2")
    With ws1
        WinFound = False
        For lngLoop = 2 To .Cells(.Rows.Count, 5).End(xlUp).Row ' Changed to avoid looking at a million rows
            If .Cells(lngLoop, 5).Value = "USA - Chicago" And _
               .Cells(lngLoop, 9).Value = "Closed/Won" And _
               .Cells(lngLoop, 18).Value = wk1 Then
                .Rows(lngLoop).EntireRow.Copy Destination:=ws2.Range("A" & ws2.Rows.Count).End(xlUp).Offset(1)
                WinFound = True
            End If
        Next lngLoop
        If Not WinFound Then
            ws2.Range("F1") = "No wins this week"
        End If
    End With
    Application.ScreenUpdating = True
End Sub

well i had to adjust the Destination:=ws2.Range("A:A" & ws2.Rows.Count). to just be "A" instead of "A:A" because i was getting an error. but it works now. will really put it to the test when i get Q1 wins rolling in. thanks!! — IFianTHENdisplayname, Dec 28 '16 at 18:00
@IFianTHENdisplayname - Oops - sorry - I missed that error. Your correction is exactly correct, and I will update the answer to include it. — YowE3K, Dec 28 '16 at 18:44
so i have two of these subs for different tabs. i have run them and they both work great. however, after running the last one, my workbook is sooooooo slow. its taking several minutes for me to select a cell. i know all this code on a single workbook bogs it down but i feel like it is still trying to run something in the background. can i clean it up somehow? Note: i did add `With ws2 .Rows(4 & ":" & .Rows.Count).Delete End With` because i wanted to delete the previous results and couldnt figure out how to paste multiple rows in a range overwriting what is already there — IFianTHENdisplayname, Dec 28 '16 at 20:14
another problem i have is when i adjusted it to another sheet but the exact same process the "no wins this week" shows up everytime even though the code is literally exactly the same. whats the troubleshoot for that? it works properly on the other sheet? — IFianTHENdisplayname, Dec 28 '16 at 20:15
@IFianTHENdisplayname - that edit will be attempting to delete about 1 million rows - change `.Rows(4 & ":" & .Rows.Count).Delete` to `.Range("A4:A" & .Cells(.Rows.Count,"A").End(xlUp).Row).EntireRow.ClearContents`. (That will just clear the contents without deleting formats, etc, but should be fine for your purpose and will be faster.) — YowE3K, Dec 28 '16 at 20:21
@IFianTHENdisplayname - as for why it doesn't work on a different sheet ... I'm not sure. Is it copying rows to the destination sheet, while still saying "No wins"? If so, all I can suggest is that you step through the code in debug mode and see what it is doing. (It must be clearing `WinFound` for some reason.) If it isn't copying any rows, I suggest that one of the tests that you have isn't matching correctly, so step through until you get to a line that you think should match, then check the variables being used in the `If` statement to see if they are what you think they should be. — YowE3K, Dec 28 '16 at 20:27
thanks for the tip! i imagine deleting 1m rows is draining. and i will re-check the no wins code. ill revert with any more issues i cannot figure out myself. — IFianTHENdisplayname, Dec 28 '16 at 20:56

Copy whole row across workbooks based on multiple criteria

1 Answers1