mardi 27 décembre 2016

Copy whole row across woorkbooks based on multiple citeria

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

Aucun commentaire:

Enregistrer un commentaire