CODEWITHSUNDEEP
vbaexcel
user2519726
user2519726

Reputation: 149

VBA copy row from one sheet to another based on 2 criteria

i have 2 sheeets. basically ws1 is the destination, ws2 is the source. then i have 2 criterias, an ID Number, and a name of the person who will work on the ID Number.

source contains a row with new actions/progress done by "working person" and need to paste it on the destination in order to update it.

I've read around and saw that autofilter looks like the way to go. i have a code here that autofilters, but i'm just not sure how i can "attack" the problem. 

Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastrowDest As Long, currow As Long, lastrowSrc As Long
Dim critvalue1 As String


'Destination sheet (dashboard)
Set ws1 = Sheets("Destination")
'Source Sheet (source)
Set ws2 = Sheets("Source")

lastrowSrc = ws2.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
lastrowDest = ws1.Range("A" & Rows.Count).End(xlUp).Row



For currow = 2 To lastrowSrc

critvalue1 = ws2.Range("E" & currow).Value

ws1.Range("A1").AutoFilter field:=5, Criteria1:=critvalue1



Next currow

end sub

is there an easy way to copy the row from source to destination provided that the IDnumber matches? (the IDnumber is unique)

the code above filters but i'm not sure of how to copy or move the rows.

thanks in advance.

Upvotes: 2

Views: 5212

Answers (3)

bbishopca
bbishopca

Reputation: 296

This could be done with SUMPRODUCT or VLOOKUP but if you are set on VBA then try this

Sub copyRow()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastrowDest As Long, currowSrc As Long, currowDest As Long, lastrowSrc As Long
Dim critvalue1 As String

Set ws1 = Sheets("Sheet2")
Set ws2 = Sheets("Sheet1")

lastrowSrc = ws2.Range("A" & Rows.Count).End(xlUp).Offset(1).Row - 1
lastrowDest = ws1.Range("A" & Rows.Count).End(xlUp).Row

For currowSrc = 2 To lastrowSrc
    critvalue1 = ws2.Range("E" & currowSrc).Value
    ws2.Cells(6, 5).Value = critvalue1
    For currowDest = 2 To lastrowDest
        If ws1.Range("E" & currowDest).Value = critvalue1 Then
           ws2.Rows(currowSrc).Copy Destination:=ws1.Range("A" & currowDest)
        End If
    Next currowDest
Next currowSrc

End Sub

I find it easier than dealing with the autofilter. It goes row by row from the source sheet and checks for a match in every row of the destination sheet. If there is a match, the source row in copied to the matching destination row.

To keep formatting instead of 

ws2.Rows(currowSrc).Copy Destination:=ws1.Range("A" & currowDest)

use 

ws2.Rows(currowSrc).Copy
ws1.Range("A" & currowDest).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats

Upvotes: 2

Michael S Priz
Michael S Priz

Reputation: 1126

One method is by using the Copy method of the Range object. This should generally be avoided though as this overwrites the clipboard. A safer option is to simply use rngDest.Value = rngSrc.Value. Note that for this to work the ranges must be the same size. Here is how this is normally used:

Dim dst As Range
Dim src As Range
Set src = Range("A1:B3") 'Data you want to copy 
Set dst = Range("C1") 'First cell in the destination Range
Set dst = dst.Resize(src.Rows.Count, src.Columns.Count) 'Resize to match src
dst.Value = src.Value 'Copy to destination

This method has the benefit of preserving the clipboard!

Upvotes: 0

Alex R.
Alex R.

Reputation: 320

I pulled this out of a larger macro I use and made some changes to make it match your method a little better and I deleted some irrelevant stuff. The variable names are a bit different. I believe this does what you need. Let me know if it gives you trouble. Don't forget to populate the ID and Name arrays, set the value for the 2 column variables and assign the sheet names before running.

Sub copyByAutofilter()

Dim filterList1 As Variant
    filterList1 = Array("ID1", "ID2")
    filterCol1 = 1 'or whatever column contains the IDs
Dim filterList2 As Variant
    filterList2 = Array("Name1", "Name2")
    filterCol2 = 2 'or whatever column contains the names

Dim sourceWB As String
    sourceWB = ThisWorkbook.Name
Dim sourceWS As String
    sourceWS = "Sheet2"
Dim destinationWB As String
    destinationWB = ThisWorkbook.Name
Dim destinationWS As String
    destinationWS = "Sheet3"

lastrowSrc = Sheets(sourceWS).Range("A" & Rows.Count).End(xlUp).Offset(1).Row
lastrowDest = Sheets(destinationWS).Range("A" & Rows.Count).End(xlUp).Row

Workbooks(sourceWB).Sheets(sourceWS).AutoFilterMode = False

Workbooks(sourceWB).Sheets(sourceWS).Range("$A$1:$O" & lastrowSrc).AutoFilter Field:=filterCol1, _
        Criteria1:=filterList1, Operator:=xlFilterValues
Workbooks(sourceWB).Sheets(sourceWS).Range("$A$1:$O" & lastrowSrc).AutoFilter Field:=filterCol2, _
        Criteria1:=filterList2, Operator:=xlFilterValues

Workbooks(sourceWB).Sheets(sourceWS).Range("A2:O" & lastrowSrc).SpecialCells _
        (xlCellTypeVisible).Copy _
        Destination:=Workbooks(destinationWB).Sheets(destinationWS).Cells(lastrowDest + 1, 1)

End Sub

Upvotes: 0

Related Questions