Copy & paste of the data if matches

zyxw1234
Banned
Posts: 253
Joined: 22 Apr 2020, 17:24

Copy & paste of the data if matches

Post by zyxw1234 »

Code: Select all

Sub CompareCols()
    Application.ScreenUpdating = False
    Dim LastRow As Long, Val As String, ws1 As Worksheet, ws2 As Worksheet, i As Long, v1, v2, RngList As Object
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")
    v1 = ws1.Range("A2", ws1.Range("A" & Rows.Count).End(xlUp)).Resize(, 4).Value
    v2 = ws2.Range("B1", ws2.Range("B" & Rows.Count).End(xlUp)).Resize(, 10).Value
    Set RngList = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(v2, 1)
        Val = v2(i, 1)
        If Not RngList.Exists(Val) Then
            RngList.Add Val, Nothing
        End If
    Next i
    For i = 1 To UBound(v1, 1)
        Val = v1(i, 1)
        If RngList.Exists(Val) Then
            ws1.Cells(i + 1, 4) = v2(i, 10)
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

this code is not working as i wanted plz see the file which i have attached
it should paste the correct data but it is pasting incorrect data

Plz see the attachments
If column A of sheet1 matches with column B of sheet2 then copy column K data of sheet2 & paste it to column D of sheet1 & save the changes
I need the macro of the same
Output after runing the macro is pasted in sheet3 plz have a look(Only for understanding purpose it is putted in sheet3)


https://drive.google.com/open?id=1VtG-p ... qivrOtbMb5

User avatar
HansV
Administrator
Posts: 78231
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Copy & paste of the data if matches

Post by HansV »

In the line ws1.Cells(i + 1, 4) = v2(i, 10) you're using i as row number for both Sheet1 and Sheet2. That is not correct, of course.

Code: Select all

Sub CompareCols()
    Application.ScreenUpdating = False
    Dim Val As String, ws1 As Worksheet, ws2 As Worksheet, i As Long, v1, v2, RngList As Object
    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")
    v1 = ws1.Range("A2", ws1.Range("A" & Rows.Count).End(xlUp)).Resize(, 4).Value
    v2 = ws2.Range("B1", ws2.Range("B" & Rows.Count).End(xlUp)).Resize(, 10).Value
    Set RngList = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(v2, 1)
        Val = v2(i, 1)
        If Not RngList.Exists(Val) Then
            RngList.Add Val, v2(i, 10) ' *** CHANGED! ***
        End If
    Next i
    For i = 1 To UBound(v1, 1)
        Val = v1(i, 1)
        If RngList.Exists(Val) Then
            ws1.Cells(i + 1, 4) = RngList(Val) ' *** CHANGED! ***
        End If
    Next i
    Application.ScreenUpdating = True
End Sub
Best wishes,
Hans

User avatar
HansV
Administrator
Posts: 78231
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Copy & paste of the data if matches

Post by HansV »

Shorter:

Code: Select all

Sub CompareCols()
    Application.ScreenUpdating = False
    Dim LastRow As Long, ws1 As Worksheet
    Set ws1 = Sheets("Sheet1")
    LastRow = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
    With ws1.Range("D2:D" & LastRow)
        .Formula = "=IFERROR(VLOOKUP(A2,Sheet2!B:K,10,FALSE),"""")"
        .Value = .Value
    End With
    Application.ScreenUpdating = True
End Sub
Best wishes,
Hans

zyxw1234
Banned
Posts: 253
Joined: 22 Apr 2020, 17:24

Re: Copy & paste of the data if matches

Post by zyxw1234 »

Code: Select all

Sub STEP4()
Dim w1 As Workbook
Set w1 = ActiveWorkbook
    Application.ScreenUpdating = False
    Dim Val As String, ws1 As Worksheet, ws2 As Worksheet, i As Long, v1, v2, RngList As Object
    Set ws1 = w1.Worksheets.Item(1)
    Set ws2 = w1.Worksheets.Item(2)
    v1 = ws1.Range("A2", ws1.Range("A" & Rows.Count).End(xlUp)).Resize(, 4).Value
    v2 = ws2.Range("B1", ws2.Range("B" & Rows.Count).End(xlUp)).Resize(, 10).Value
    Set RngList = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(v2, 1)
        Val = v2(i, 1)
        If Not RngList.Exists(Val) Then
            RngList.Add Val, v2(i, 10) ' *** CHANGED! ***
        End If
    Next i
    For i = 1 To UBound(v1, 1)
        Val = v1(i, 1)
        If RngList.Exists(Val) Then
            ws1.Cells(i + 1, 4) = RngList(Val) ' *** CHANGED! ***
        End If
    Next i
    Application.ScreenUpdating = True
w1.Save
End Sub


I used this
Thnx Alot HansV Sir for helping me in solving this problem
Have a Great Day