Updating Specific Rows on Different Workbook, Where Cell Values Match between Two Workbooks

reberryjr

Well-known Member
Joined
Mar 16, 2017
Messages
714
Office Version
  1. 365
Platform
  1. Windows
I have 2 workbooks. Each workbook has a sheet called Active_Inv. I'm trying to update the main workbook (Deposit Application) with specific cell values from the second workbook (Chelsea_FLP), where the values of column V and AE are equal. I have googled and googled for over a week, but have been unable to find anything that helps. I've tried the following sets of code, but none of them work. As of right now, I'm fine with comparing the entire sheet, but ideally, it would only look at records on the Chelsea_FLP sheet, where the value of column O is not null. I'll wind up duplicating this code about 10 times, to account for other sheets, but I should just be able to change the file path and file name for each one of those (in separate modules).

This first set of code brings over the correct info, but is entering it on the same row number, instead of where the value of columns V and AE match. The second set of code results in a "Object doesn't support this property or method." error.

Code:
Sub MergeEODFLP()
Application.ScreenUpdating = False
Dim m, flp As Workbook
Dim mws2, flpws2 As Worksheet
Dim mRng, flpRng, FindRow, mCell, flpCell As Range
Dim RngList As Object
Dim UpdateRow, fLastRow As Long
Set m = ThisWorkbook
Set mws2 = ThisWorkbook.Sheets("Active_Inv")
Set RngList = CreateObject("Scripting.Dictionary")
On Error Resume Next
Set flp = Workbooks.Open("[URL="file://\\FilePath"]\\FilePath[/URL]")
Set flpws2 = flp.Sheets("Active_Inv")
For Each Rng In flpws2.Range("V2", flpws2.Range("V" & flpws2.Rows.Count).End(xlUp))
    If Not RngList.exists(Rng.Value & Rng.Offset(0, 9)) Then
        RngList.Add Rng.Value & Rng.Offset(0, 9), Nothing
    End If
Next
For Each Rng In mws2.Range("V2", mws2.Range("V" & mws2.Rows.Count).End(xlUp))
    If RngList.exists(Rng.Value & Rng.Offset(0, 9)) Then
        UpdateRow = mws2.RngList.Row
        mws2.Range("G" & UpdateRow).Value = flpws2.Range("G" & Rng.Row).Value
        mws2.Range("H" & UpdateRow).Value = flpws2.Range("H" & Rng.Row).Value
        mws2.Range("I" & UpdateRow).Value = flpws2.Range("I" & Rng.Row).Value
        mws2.Range("J" & UpdateRow).Value = flpws2.Range("J" & Rng.Row).Value
        mws2.Range("K" & UpdateRow).Value = flpws2.Range("K" & Rng.Row).Value
        mws2.Range("L" & UpdateRow).Value = flpws2.Range("L" & Rng.Row).Value
        mws2.Range("M" & UpdateRow).Value = flpws2.Range("M" & Rng.Row).Value
        mws2.Range("N" & UpdateRow).Value = flpws2.Range("N" & Rng.Row).Value
        mws2.Range("O" & UpdateRow).Value = flpws2.Range("O" & Rng.Row).Value
    End If
Next
'With mws2
'For Each flpCell In flpws2.Range("BQ", Sheets("Active_Inv").Cells(Rows.Count, "BQ").End(xlUp))
'    Set FindRow = mws2.Range("BQ").Find(What:=flpCell.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)
'        If Not FindRow Is Nothing Then
'            UpdateRow = FindRow
'        Else
'            Exit Sub
'        End If
'
'        mws2.Range("G" & UpdateRow).Value = flpws2.Range("G" & flpCell).Value
'        mws2.Range("H" & UpdateRow).Value = flpws2.Range("H" & flpCell).Value
'        mws2.Range("I" & UpdateRow).Value = flpws2.Range("I" & flpCell).Value
'        mws2.Range("J" & UpdateRow).Value = flpws2.Range("J" & flpCell).Value
'        mws2.Range("K" & UpdateRow).Value = flpws2.Range("K" & flpCell).Value
'        mws2.Range("L" & UpdateRow).Value = flpws2.Range("L" & flpCell).Value
'        mws2.Range("M" & UpdateRow).Value = flpws2.Range("M" & flpCell).Value
'        mws2.Range("N" & UpdateRow).Value = flpws2.Range("N" & flpCell).Value
'        mws2.Range("O" & UpdateRow).Value = flpws2.Range("O" & flpCell).Value'
'Next flpCell
'End With
'For Each mRng In mws2.Range("V2", mws2.Range("V" & mws2.Rows.Count).End(xlUp))
'    If Not RngList.exists(Rng.Value & Rng.Offset(0, 9)) Then
'        RngList.Add Rng.Value & Rng.Offset(0, 9), Nothing
'    End If
'Next
'For Each fRng In flpws2.Range("V2", flpws2.Range("V" & flpws2.Rows.Count).End(xlUp))
'    If RngList.exists(Rng.Value & Rng.Offset(0, 9)) Then
'        mws2.Range("G" & mRng.Row).Value = flpws2.Range("G" & fRng.Row).Value
'        mws2.Range("H" & mRng.Row).Value = flpws2.Range("H" & fRng.Row).Value
'        mws2.Range("I" & mRng.Row).Value = flpws2.Range("I" & fRng.Row).Value
'        mws2.Range("J" & mRng.Row).Value = flpws2.Range("J" & fRng.Row).Value
'        mws2.Range("K" & mRng.Row).Value = flpws2.Range("K" & fRng.Row).Value
'        mws2.Range("L" & mRng.Row).Value = flpws2.Range("L" & fRng.Row).Value
'        mws2.Range("M" & mRng.Row).Value = flpws2.Range("M" & fRng.Row).Value
'        mws2.Range("N" & mRng.Row).Value = flpws2.Range("N" & fRng.Row).Value
'        mws2.Range("O" & mRng.Row).Value = flpws2.Range("O" & fRng.Row).Value
'    End If
'Next
'For Each Rng In flpws2.Range("V2", flpws2.Range("V" & flpws2.Rows.Count).End(xlUp))
'    If Not RngList.exists(Rng.Value & Rng.Offset(0, 9)) Then
'        Set flpRng = Rng.Value & Rng.Offset(0, 9)
'        RngList.Add Rng.Value & Rng.Offset(0, 9), Nothing
'    End If
'Next
'For Each Rng In mws2.Range("V2", mws2.Range("V" & mws2.Rows.Count).End(xlUp))
'    If RngList.exists(Rng.Value & Rng.Offset(0, 9)) Then
'        mws2.Range("G" & UpdateRow).Value = flpws2.Range("G" & Rng.Row).Value
'        mws2.Range("H" & UpdateRow).Value = flpws2.Range("H" & Rng.Row).Value
'        mws2.Range("I" & UpdateRow).Value = flpws2.Range("I" & Rng.Row).Value
'        mws2.Range("J" & UpdateRow).Value = flpws2.Range("J" & Rng.Row).Value
'        mws2.Range("K" & UpdateRow).Value = flpws2.Range("K" & Rng.Row).Value
'        mws2.Range("L" & UpdateRow).Value = flpws2.Range("L" & Rng.Row).Value
'        mws2.Range("M" & UpdateRow).Value = flpws2.Range("M" & Rng.Row).Value
'        mws2.Range("N" & UpdateRow).Value = flpws2.Range("N" & Rng.Row).Value
'        mws2.Range("O" & UpdateRow).Value = flpws2.Range("O" & Rng.Row).Value
'    End If
'Next
RngList.RemoveAll
Application.ScreenUpdating = True
MsgBox "Complete"
End Sub

Code:
Sub MergeFiles()
Application.ScreenUpdating = False
Dim m, flp As Workbook
Dim mws2, flpws2 As Worksheet
Dim Rng As Range
Dim mLst, flpLst As Object
Set m = ThisWorkbook
Set mws2 = ThisWorkbook.Sheets("Active_Inv")
Set mLst = CreateObject("Scripting.Dictionary")
Set flp = Workbooks.Open("[URL="file://\\File Path"]\\File Path[/URL]")
Set flpws2 = flp.Sheets("Active_Inv")
Set flpLst = CreateObject("Scripting.Dictionary")
For Each Rng In mws2.Range("V2", mws2.Range("V" & mws2.Rows.Count).End(xlUp))
    If Not mLst.exists(Rng.Value & Rng.Offset(0, 9)) Then
        mLst.Add Rng.Value & Rng.Offset(0, 9), Nothing
    End If
Next
For Each Rng In flpws2.Range("V2", flpws2.Range("V" & flpws2.Rows.Count).End(xlUp))
    If Not flpLst.exists(Rng.Value & Rng.Offset(0, 9)) Then
        flpLst.Add Rng.Value & Rng.Offset(0, 9), Nothing
    End If
If mLst.Row.Value = flpLst.Row.Value Then
    mws2.Range("G" & mLst).Value = flpws2.Range("G" & flpLst).Value
End If
Next
mLst.RemoveAll
flpLst.RemoveAll
Application.ScreenUpdating = True
MsgBox "Complete"
End Sub
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
I was able to get this code to work.

Code:
Sub MergeChelsea1LPLoans()
Application.ScreenUpdating = False
Dim m, flp As Workbook
Dim mws2, flpws2 As Worksheet
Dim i, j As Long
Dim Rng1, Rng2 As Range
Set m = ThisWorkbook
Set mws2 = ThisWorkbook.Sheets("Active_Inv")
mLR = mws2.Range("V" & Rows.Count).End(xlUp).Row
Set flp = Workbooks.Open("[URL="file://\\File Path"]\\File Path[/URL]")
Set flpws2 = flp.Sheets("Active_Inv")
flpLR = flpws2.Range("V" & Rows.Count).End(xlUp).Row
For i = 1 To mLR
    Set Rng1 = mws2.Range("V" & i)
    
    For j = 1 To flpLR
        Set Rng2 = flpws2.Range("V" & j)
        
        If StrComp(CStr(Rng1.Value), CStr(Rng2.Value), vbTextCompare) = 0 Then
            If Rng1.Offset(0, 9).Value = Rng2.Offset(0, 9).Value Then
                mws2.Range("G" & i).Value = flpws2.Range("G" & j).Value
                mws2.Range("H" & i).Value = flpws2.Range("H" & j).Value
                mws2.Range("I" & i).Value = flpws2.Range("I" & j).Value
                mws2.Range("J" & i).Value = flpws2.Range("J" & j).Value
                mws2.Range("K" & i).Value = flpws2.Range("K" & j).Value
                mws2.Range("L" & i).Value = flpws2.Range("L" & j).Value
                mws2.Range("M" & i).Value = flpws2.Range("M" & j).Value
                mws2.Range("N" & i).Value = flpws2.Range("N" & j).Value
                mws2.Range("O" & i).Value = flpws2.Range("O" & j).Value
            End If
        End If
    Next j
Next i
Application.ScreenUpdating = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,246
Messages
6,170,996
Members
452,373
Latest member
TimReeks

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top