Copy ranges and multiply in loop

Question

Ive been searching left and right but seem to only find bits and pieces. i'm unable to combine these into the solution i need. My workbook has a list of items on the first sheet, the partnumbers in column A have to be searched for in Column A of a second sheet and if they exist there, those rows need to be copied to a third sheet.In steps i'm looking to do the following:

Column A of sheet1 (called "input") has several partnumbers.
After clicking CommandButton2 on sheet1, all partnumbers in Column A (starting in cell A5)should be searched for in Column A of sheet3 (called "partlists", starting in A2).
If found here, for all the respective rows where the partnumbers match: columns C to G("partlists") should be copied to sheet2("picklist") column A below the last row, the value in column E("picklist") has to be multiplied with the value in Column E("input") AND columns G to K("input") copied to the respective rows column G("Picklist")
If not found on "partlists", copy entire row from "input" to "picklist" below last row.

So far i've got the following code:

Sub InputPickMatch()

Dim LR As Long, i As Long, lngNextRow As Long, LookUpListInput As Range, LookUpListParts As Range

Set LookUpListInput = Sheets("Input").Range("A:A") 'lookup list Input
Set LookUpListParts = Sheets("Partlists").Range("A:A")

With Sheets("Input")
    LR = .Cells(Rows.Count, "A").End(xlUp).Row 'last row
        For i = 5 To LR
        If IsError(Application.Match(.Cells(i, "A").Value, LookUpListParts, 0)) Then
            .Range(Cells(i, "A").Address(), Cells(i, "D").Address()).Copy
            Sheets("Picklist").Select
            lngNextRow = Sheets("Picklist").Range("A" & Rows.Count).End(xlUp).Row + 1
            Sheets("Picklist").Range("A" & lngNextRow).PasteSpecial _
            Paste:=xlPasteValues
            .Range(Cells(i, "F").Address(), Cells(i, "K").Address()).Copy
            Sheets("Picklist").Range("E" & lngNextRow).PasteSpecial _
            Paste:=xlPasteValues
            End If
    Next i
End With

With Sheets("Partlists")
    LR = .Cells(Rows.Count, "A").End(xlUp).Row 'last row
        For i = 3 To LR
        If IsNumeric(Application.Match(.Cells(i, "A").Value, LookUpListInput, 0)) Then
            .Range(Cells(i, "C").Address(), Cells(i, "G").Address()).Copy
            Sheets("Picklist").Select
            lngNextRow = Sheets("Picklist").Range("A" & Rows.Count).End(xlUp).Row + 1
            Sheets("Picklist").Range("A" & lngNextRow).PasteSpecial _
            Paste:=xlPasteValues
            'Sheets("Picklist").Cells(lngNextRow, "E") = Sheets("Input").Cells(LookUpListInput, "E") * .Cells(i, "G") 'NOT WORKING: Multiply row from lookuplist column E with .Cells(i, "G")
            'Sheets("Input").Range(Cells(LookUpList, "G").Address(), Cells(LookUpListInput, "K").Address()).Copy      'NOT WORKING: Copy row from lookuplist column G:K
            'Sheets("Picklist").Range("F" & lngNextRow).PasteSpecial                                             'Paste Picklist column G
            End If
    Next i
End With

End Sub

It's working ok up to where i try to multiply and copy from the lookup list.

Hopefully someone can help

What happens when you try to copy? Do you see an error? If so, what is the error? **Hint**: you don't need the `Select` statements. Code will work without selecting the sheet you want to interact with — Zac, Jan 15 '20 at 15:56
It gives error 13 type mismatch (the latter translated from dutch so hope it makes sense) — Dennis B, Jan 15 '20 at 16:06
Have a look at `resize` option in VBA. I think that should resolve your issue — Zac, Jan 15 '20 at 16:09
Here is some info on [avoiding select in your code](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). If you are only going to copy/paste values, you may as well assign the values from one range to another. ex.: `Range("A2").value = Range("A1").value` — cybernetic.nomad, Jan 15 '20 at 16:24
I think the issue is that is use LookUpListInput (which is dimmed as range) to point to the row on the "input" sheet where the match has been found. How can i get the result (row number) of the Application.Match? — Dennis B, Jan 15 '20 at 17:02
@ cybernetic.nomad Tried your suggestion, seems to be much smoother. Thanks — Dennis B, Jan 15 '20 at 17:40
@cybernetic.nomad - event better when many cells are "selected" with `Range("A2").Resize(10,1).Value = Range("G2").Resize(10,1).Value` — John Alexiou, Jan 15 '20 at 22:44

score 0 · Answer 1 · answered Jan 15 '20 at 20:49

I got it guys

Sub InputToPicklist()

Dim LR As Long, i As Long, lngNextRow As Long, LookUpListInput As Range, LookUpListParts As Range
Dim Matchres As Variant

Set LookUpListInput = Sheets("Input").Range("A:A")
Set LookUpListParts = Sheets("Partlists").Range("A:A")

With Sheets("Input")
    LR = .Cells(Rows.Count, "A").End(xlUp).Row
        For i = 5 To LR
        If IsError(Application.Match(.Cells(i, "A").Value, LookUpListParts, 0)) Then
             lngNextRow = Sheets("Picklist").Range("A" & Rows.Count).End(xlUp).Row + 1
             Sheets("Picklist").Range(Cells(lngNextRow, "A").Address(), Cells(lngNextRow, "D").Address()).Value = .Range(Cells(i, "A").Address(), Cells(i, "D").Address()).Value
             Sheets("Picklist").Range(Cells(lngNextRow, "E").Address(), Cells(lngNextRow, "J").Address()).Value = .Range(Cells(i, "F").Address(), Cells(i, "K").Address()).Value
             End If
    Next i
End With

With Sheets("Partlists")
    LR = .Cells(Rows.Count, "A").End(xlUp).Row 'last row
        For i = 3 To LR
        If IsNumeric(Application.Match(.Cells(i, "A").Value, LookUpListInput, 0)) Then
            lngNextRow = Sheets("Picklist").Range("A" & Rows.Count).End(xlUp).Row + 1
            Sheets("Picklist").Range(Cells(lngNextRow, "A").Address(), Cells(lngNextRow, "E").Address()).Value = .Range(Cells(i, "C").Address(), Cells(i, "G").Address()).Value
            Matchres = Application.Match(.Cells(i, "A").Value, LookUpListInput, 0)
            Sheets("Picklist").Cells(lngNextRow, "E") = Sheets("Input").Cells(Matchres, "F") * .Cells(i, "G")    'Multiply row from lookuplist column E with .Cells(i, "G")
            Sheets("Picklist").Range(Cells(lngNextRow, "F").Address(), Cells(lngNextRow, "J").Address()).Value = Sheets("Input").Range(Cells(Matchres, "G").Address(), Cells(Matchres, "K").Address()).Value     'Copy row from lookuplist column G:K

            End If
    Next i
End With

Sheets("Input").Range("A5:K138").ClearContents

End Sub

First

Dim Matchres As Variant

and calling it

Matchres = Application.Match(.Cells(i, "A").Value, LookUpListInput, 0)

Does the trick

Copy ranges and multiply in loop

1 Answers1