Updating existing records in closed workbook VBA from current open workbook

[jam1531]

Hello,

Any help appreciated. I tried finding an existing thread on it but could not find one close enough. Long story short, I have two excel files. One is called "Item Impact and Cause" and stores a list of 4 columns which are (1) Item Number, (2) Root Cause, (3) Recovery Week, and (4) Comment. These are all on sheet1.

The second workbook is called "Upload" and contains the same columns as above. When a user clicks the macro I would like the "Item Impact and Cause" workbook (even if closed) to be updated with this logic. If the item already exists it finds it and updates columns 2-4. If the item does not exist it adds it to the list on workbook "Upload".

Sounds easy enough but I am lost. I am sure it is much easier than what I think. Please help.

 

[mumps]

It is hard to work with a picture. Use the XL2BB add-in (icon in the menu) to attach screen shots of Sheet1 in "Item Impact and Cause" and sheet "Push Data" in "Upload".

 

[jam1531]

Item Impact and Cause.xlsx
	A	B	C	D
1	Item	Root Cause	Recovery week	Comment
2	123	Shortage	24	Supplier unable to obtain raw ingredients
3	5555	Forecast	25	Initial too low. We have corrected.
4	34356	Shortage	22	Supplier unable to obtain raw ingredients
5	22	Other	TBD	Still researching.
PI Data

Upload.xlsx
	A	B	C	D
1
2
3	Item	Root Cause	Recovery week	Comment
4	123	Shortage	24	Supplier unable to obtain raw ingredients
5	5555	Forecast	25	Initial too low. We have corrected.
6	34356	Shortage	22	Supplier unable to obtain raw ingredients
7	22	Other	TBD	Still researching.
Push Data

 

[jam1531]

It is hard to work with a picture. Use the XL2BB add-in (icon in the menu) to attach screen shots of Sheet1 in "Item Impact and Cause" and sheet "Push Data" in "Upload".

Posted.

 

[mumps]

Thanks. To clarify: If the item in column A in "Upload" is found in column A of "Item Impact and Cause", you want to copy B:D in "Upload" to B:D in "Item Impact and Cause" in the corresponding row. If the item in column A in "Item Impact and Cause" is not found in column A of "Upload", you want to copy A:D in ""Item Impact and Cause"" to A:D in "Upload" in the first available row. Is this correct?

 

[jam1531]

Thanks. To clarify: If the item in column A in "Upload" is found in column A of "Item Impact and Cause", you want to copy B:D in "Upload" to B:D in "Item Impact and Cause" in the corresponding row. If the item in column A in "Item Impact and Cause" is not found in column A of "Upload", you want to copy A:D in ""Item Impact and Cause"" to A:D in "Upload" in the first available row. Is this correct?

Yep! You got it. Essentially just trying to make it so it updates a list or, in the case of where an item is new, adds it to the list.

 

[mumps]

What is the full path to the folder containing the "Item Impact and Cause" workbook? Is it in the sane folder as the "Upload" workbook?

 

[jam1531]

It's c:\users\mckibble\My stuff

 

[mumps]

Try:

Sub UpdateRecords()
    Application.ScreenUpdating = False
    Dim sFilename As String, sPath As String, Val As String, ws1 As Worksheet, ws2 As Worksheet, i As Long, v1, v2, RngList As Object
    sFilename = "Item Impact and Cause.xlsx"
    sPath = "c:\users\mckibble\My stuff\"
    Set ws1 = ThisWorkbook.Sheets("PI Data")
    If AlreadyOpen(sFilename) Then
        'Do nothing
    Else
        Workbooks.Open sPath & sFilename
        Set ws2 = Sheets("Push Data")
        v1 = ws1.Range("A2", ws1.Range("A" & Rows.Count).End(xlUp)).Resize(, 4).Value
        v2 = ws2.Range("A2", ws2.Range("A" & Rows.Count).End(xlUp)).Resize(, 4).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, 2).Resize(, 3).Value = Array(v2(i, 2), v2(i, 3), v2(i, 4))
            Else
                ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 4).Value = Array(v1(i, 1), v1(i, 2), v1(i, 3), v1(i, 4))
            End If
        Next i
    End If
    Application.ScreenUpdating = True
End Sub

Function AlreadyOpen(sFname As String) As Boolean
    Dim wkb As Workbook
    On Error Resume Next
    Set wkb = Workbooks(sFname)
    AlreadyOpen = Not wkb Is Nothing
    Set wkb = Nothing
End Function