Compare Values and Paste corresponding values in another sheet

Question

I'm currently trying to run a Macro that looks for a value from column A of 'sheet 1' in column A of sheet 2, if these match then it should check the values from D3:M3 in Sheet1 against values in Column M in Sheet2, if they match then it should copy the corresponding values from SHeet1 D2 to M2, into ColumnP for Sheet2. I know it's a tricky one, so here's an exmple of what I need, and what I have done so far..

Now If you look at the 1st image that's sheet1, and 2nd image is Sheet 2 I need to check the userID(ColumnA) for sheet1, against the Awardexternal ID (ColumnA) for Sheet2, this is followed by another check - amount entered in Sheet2.ColumnM against the Amount entered in the corresponding UserID's row in this case D3 - M3.sheet1 :

Example - User A1111111 has enetered $100 as Mobile Phone Bill expense, all I want to do is check for the user id, then compare the amount they have entered and then paste the right "TYPE" of expense (in this case - Mobile phone Bill) in sheet2 Column P.

What I've done so far is:

Application.ScreenUpdating = False

Dim j As Long, i As Long, lastRow1 As Long, lastRow2 As Long

Dim MyName As String

lastRow1 = ws1.UsedRange.Rows.Count

For j = 2 To lastRow1
MyName = ws1.Cells(j, 1).Value


lastRow2 = ws2.UsedRange.Rows.Count

For i = 2 To lastRow2
    If ws2.Cells(i, 3).Value = MyName Then
        ws2.Cells(i, 13).Value = ws1.Cells(j, 2).Value
    End If

Next i

Next j

Application.ScreenUpdating = True

When I try and run this, it just crashes the workbook. and nothing happens.

PS - I'm new to VBA, and do not have any experience in it. whatever I have done is googling and then trying to make the logic work.

Any help is appreciated! Thanks in advance!! :)

I need the output to look something like this:

What does the expected output look like? Where's column P? Do you need VBA, you might be able to do this with a formula. — BruceWayne, Apr 16 '18 at 05:05
`[A]` Do not use `UsedRange.Rows.Count` to find the last row. See [THIS](https://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-vba/11169920#11169920) `[B]` Avoid working with the worksheet directly. Use Arrays. There are lot of examples in the SO on how to export the data from worksheet to array and then work with it. — Siddharth Rout, Apr 16 '18 at 05:07
Could you show a fully worked example and be sure to include all the relevant columns in the images? A third image with an example desired outcome also. For example, Are you copying each that match after column A matches or only if all the mentioned columns match. And do you start pasting the matches from Sheet one in column P sheet2? — QHarr, Apr 16 '18 at 05:12
I've edited the question, If I've missed out anything, please let me know. Cheers! — Devyani Chaturvedi, Apr 16 '18 at 05:18
@QHarr Copying everything after Column A matches, Perhaps something like if Column A match then copy the corresponding Row. But at the same time I need the expense Type in Column P sheet 2. — Devyani Chaturvedi, Apr 16 '18 at 05:26
Two pieces of advice: 1. Put a DoEvents inside the loop. It'll help you avoid freezing, or at least give you some indication on what's happening. 2. Step through your code using F8 — Sam, Apr 16 '18 at 05:44

paul bica · Accepted Answer · 2018-04-17T02:08:23.320

Place this code in Sheet1 VBA Module:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lr As Long

    lr = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
    With Target
       If Not Intersect(Target, Me.Range("D2:M" & lr)) Is Nothing And .CountLarge = 1 Then
          If Not IsError(.Value) Then
             If Len(.Value2) > 0 Then
                'Copy User ID, Submitted Date, and Amount (+ Amount Description)
                 CopyData Me.Cells(.Row, "A"), Me.Cells(.Row, "C"), Target
             End If
          End If
       End If
    End With
End Sub

Place this code in a Standard VBA Module:

Option Explicit

Public Sub CopyData(ByRef usrId As Range, ByVal amtDate As Range, ByVal amt As Range)
    Const COL_USER = "A"
    Const COL_DATE = "H"
    Const COL_RATE = "M"    'Amount
    Const COL_DESC = "P"    'Amount description (Sheet1 Header)

    Dim ws1 As Worksheet:   Set ws1 = usrId.Parent
    Dim ws2 As Worksheet:   Set ws2 = Sheet2

    Dim lr2 As Long, r2 As Variant, usrRng As Range, usrRow2 As Long
    Dim ws1data As Range, ws2data As Range

    lr2 = ws2.Cells(ws2.Rows.Count, COL_USER).End(xlUp).Row
    Set usrRng = ws2.Range(ws2.Cells(1, COL_USER), ws2.Cells(lr2, COL_USER))  'Sheet2.ColA

    r2 = Application.Match(usrId.Value2, usrRng, 0) 'Find User Id on Sheet2

    If Not IsError(r2) Then
        r2 = r2 + 1
        ws2.Rows(r2).Insert Shift:=xlDown   'Insert a new row under it
    Else
        r2 = lr2    'Insert a new record in the first empty row
    End If
    ws2.Cells(r2, COL_USER) = usrId.Value2  'Copy data
    ws2.Cells(r2, COL_DATE) = amtDate.Value
    ws2.Cells(r2, COL_RATE) = amt.Value
    ws2.Cells(r2, COL_DESC) = ws1.Cells(1, amt.Column)
End Sub

What it does:

When a user enters an amount in Sheet1, for ex "Amt 7" in my test data (image bellow, col J)
If the user modified only 1 cell, and the cell is in range "D2:M" & lr
- And If the amount entered is not an error (ex =1/0), or pasted as an error
- And the user didn't just delete the amount (empty cell)
It looks up User ID for the cell where the amount was entered, on Sheet2
- If it finds the User ID on Sheet2, it copies current values from Sheet1 to Sheet2
  - User ID - from Sheet1.ColA to Sheet2.ColA
  - Date - from Sheet1.ColC to Sheet2.ColH
  - Amount - from Sheet1.CurrentCol to Sheet2.ColM (costItemRate)
  - Amt Desc - from Sheet1.ColC (Row1 - Header) to Sheet2.ColP
- If it doesn't find it, copies current values from Sheet1 to the first empty row of Sheet2

Test Data

Sheet1

Sheet2 (Output)

Hi Paul, this is exactly what I need! thanks Heaps, I'll try running it now :) — Devyani Chaturvedi, Apr 17 '18 at 01:53

Compare Values and Paste corresponding values in another sheet

1 Answers1