Update Data at cell based on sheet selection

Hi Experts,

I would like to request Experts help to add new function in the attached script. The module able to copy and paste data from Listing workbook to MasterData workbook. However, if the Number (Column A) at “Listing” WB is similar with the number at MasterData WB (Column A), its only update data from column B to D. Is that possible to update Column E (MasterData WB) as well? If the update came from “OUT” sheet (Listing WB), Column E need to be updated as “StoreA”, if “IN” sheet, cell at Column E need to update as “StoreB”. Hope Experts will help me to add this function.  



Sub SendToMaster()
Dim i As Long, lgFoundRow As Long
Dim shtMaster As Worksheet, shtListing As Worksheet, wbkMaster As Workbook

Application.ScreenUpdating = False
On Error Resume Next

Set shtListing = ActiveSheet

Set wbkMaster = Workbooks("MasterData.xls")

If Err <> 0 Then Set wbkMaster = Workbooks.Open("D:\Data\MasterData.xls")

If wbkMaster.ReadOnly Then
MsgBox "MasterData workbook must be opened read-only for data update. Try again later"
Exit Sub
End If

Set shtMaster = wbkMaster.Sheets("MasterList")

Err.Clear

With shtListing

    For i = 3 To .Cells(.Rows.Count, 1).End(xlUp).Row
            lgFoundRow = Application.WorksheetFunction.Match(.Cells(i, 1), shtMaster.Columns(1), 0)
        
        If Err <> 0 Then
            Err.Clear
            .Rows(i).Copy shtMaster.Cells(Rows.Count, 1).End(xlUp).Offset(1)
            shtMaster.Cells(Rows.Count, 1).End(xlUp).End(xlToRight).Offset(, 1) = IIf(shtListing.Name = "OUT", "StoreA", "StoreB")
        Else
            .Range(.Cells(i, 2), .Cells(i, 4)).Copy shtMaster.Cells(lgFoundRow, 2)
        End If
        
    Next i
    
End With

wbkMaster.Close (True)

Application.ScreenUpdating = True

End Sub

Open in new window

Listing.xls
MasterData.xls
CartilloAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

SiddharthRoutCommented:
Try this

UNTESTED

Ensure that MasterData.xls is closed when you run this macro from Listing.xls. Let me know if you get any errors.

Sub SendToMaster()
    Dim i As Long, ws1lastRow As Long, ws2LastRow As Long
    Dim wb1 As Workbook, wb2 As Workbook, ws1 As Worksheet, ws2 As Worksheet
    Dim aCell As Range, strColE As String, strSearch As String
    
    Application.ScreenUpdating = False
    
    On Error GoTo Whoa
    
    Set wb1 = ActiveWorkbook
    Set ws1 = ActiveSheet
    
    ws1lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    
    Set wb2 = Workbooks.Open("D:\Data\MasterData.xls")
    Set ws2 = wb2.Sheets("MasterList")
    
    Select Case ws1.Name
    Case "IN"
        strColE = "StoreB"
    Case "OUT"
        lastRowWs2 = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
        strColE = "StoreA"
    End Select
    
    For i = 3 To ws1lastRow
        strSearch = ActiveSheet.Range("A" & i).Value
        
        Set aCell = ws2.Columns(1).Find(What:=strSearch, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        
        If Not aCell Is Nothing Then
            aCell.Offset(, 1).Value = ActiveSheet.Range("B" & i).Value
            aCell.Offset(, 2).Value = ActiveSheet.Range("C" & i).Value
            aCell.Offset(, 3).Value = ActiveSheet.Range("D" & i).Value
            aCell.Offset(, 4).Value = strColE
        Else
            ws2LastRow = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1
            ws2.Range("A" & i).Value = ActiveSheet.Range("A" & i).Value
            ws2.Range("B" & i).Value = ActiveSheet.Range("B" & i).Value
            ws2.Range("C" & i).Value = ActiveSheet.Range("C" & i).Value
            ws2.Range("D" & i).Value = ActiveSheet.Range("D" & i).Value
            ws2.Range("E" & i).Value = strColE
        End If
    Next i
    
OKLetsContinue:
    wb2.Close savechanges:=True
    Set ws2 = Nothing
    Set wb2 = Nothing
    Application.ScreenUpdating = True
    MsgBox "Done"
Whoa:
    MsgBox Err.Description
    Resume OKLetsContinue
End Sub

Open in new window


Sid
0
CartilloAuthor Commented:
Hi Sid,

I noticed few pop up boxes after “Done” message box. One with blank pop up box, another with “Resume without error” and the final one with   “Object variable or With variable not set”. After this message I can’t debug the actual line error or even exit the workbook. Please assist.
0
SiddharthRoutCommented:
Sorry just type

Exit Sub

after

MsgBox "Done"

Sid
0
Bootstrap 4: Exploring New Features

Learn how to use and navigate the new features included in Bootstrap 4, the most popular HTML, CSS, and JavaScript framework for developing responsive, mobile-first websites.

CartilloAuthor Commented:
Hi Sid,

The error message has been resolved, but the data was not copied over from Listing workbook to MasterData workbook. Please assist.
0
SiddharthRoutCommented:
Hmm... It should have been. Let me test it now.

Sid
0
SiddharthRoutCommented:
TESTED AND TRIED

This works. To test it. Delete the data in Col B-E in Sheet "MasterList"

Sub SendToMaster()
    Dim i As Long, ws1lastRow As Long, ws2LastRow As Long
    Dim wb1 As Workbook, wb2 As Workbook, ws1 As Worksheet, ws2 As Worksheet
    Dim aCell As Range, strColE As String, strSearch As String
    
    Application.ScreenUpdating = False
    
    On Error GoTo Whoa
    
    Set wb1 = ActiveWorkbook
    Set ws1 = ActiveSheet
    
    ws1lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    
    Set wb2 = Workbooks.Open("D:\Data\MasterData.xls")
    Set ws2 = wb2.Sheets("MasterList")
    
    Select Case ws1.Name
    Case "IN"
        strColE = "StoreB"
    Case "OUT"
        lastRowWs2 = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
        strColE = "StoreA"
    End Select
    
    For i = 3 To ws1lastRow
        strSearch = ActiveSheet.Range("A" & i).Value
        
        Set aCell = ws2.Columns(1).Find(What:=strSearch, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        
        If Not aCell Is Nothing Then
            aCell.Offset(, 1).Value = ws1.Range("B" & i).Value
            aCell.Offset(, 2).Value = ws1.Range("C" & i).Value
            aCell.Offset(, 3).Value = ws1.Range("D" & i).Value
            aCell.Offset(, 4).Value = strColE
        Else
            ws2LastRow = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1
            ws2.Range("A" & i).Value = ws1.Range("A" & i).Value
            ws2.Range("B" & i).Value = ws1.Range("B" & i).Value
            ws2.Range("C" & i).Value = ws1.Range("C" & i).Value
            ws2.Range("D" & i).Value = ws1.Range("D" & i).Value
            ws2.Range("E" & i).Value = strColE
        End If
    Next i
    
OKLetsContinue:
    Application.DisplayAlerts = False
    wb2.Close savechanges:=True
    Application.DisplayAlerts = True
    
    Set ws2 = Nothing
    Set wb2 = Nothing
    Application.ScreenUpdating = True
    MsgBox "Done"
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume OKLetsContinue
End Sub

Open in new window


Sid
0
CartilloAuthor Commented:
Hi Sid,

Thanks for the revised code. I need to update all data from column A to D from Listing workbook to MasterDate workbook. If the number from Column A (both workbooks) matched, than only data from column B to D copied to MasterData workbook. Hope I’m not confusing you.
0
SiddharthRoutCommented:
>>>>If the number from Column A (both workbooks) matched, than only data from column B to D copied to MasterData workbook. Hope I’m not confusing you.

If the number is in both sheets then from which sheet should it pick up the Col D values?

Sid
0
CartilloAuthor Commented:
Hi Sid,

The number should be copied from Listing workbook.
0
SiddharthRoutCommented:
Yes, I got that. I meant "IN" or "OUT" ?

Sid
0
CartilloAuthor Commented:
Hi Sid,

Sorry. Both sheets taking D column data, the only different is when the data gets updated from OUT sheet, column E at MasterData need to be updated as "StoreA", if the data updated from IN sheet, than cell at column E input will be "StoreB".  
0
SiddharthRoutCommented:
I am sorry I don't understand you.

here is the data in OUT sheet

 Number      Approved By      Date & Time      Box Number
33333      CART      3/28/2011 11:45      8888

and here is the data in IN sheet

 Number      Approved By      Date & Time      Box Number
33333      CART      3/28/2011 11:45      2323

What should be stored in "Mastersheet"? I am referring to "Box Number" as that is the only thing that is different.

Sid
0
CartilloAuthor Commented:
Hi Sid,

Apology for complicating the whole part. Here's a brief  explanation of  the purpose of having these 2 sheets. The OUT sheet referring to  Outgoing  goods with a unique badge (number) of the goods. The IN sheet referring to goods which is returned from a storage area. (we'll label the package with this number for easy reference)

When I update OUT sheet, meaning I sending the thing with  in a specific "Number", hence I update the MasterData workbook with the detail of the box that I sent to StroreA. Same goes for sheet "OUT". When the thing back from the Store, I update the received item in MasterData by using "IN" sheet.

Hope with this explanation could provide some clue how the both sheet works. Therefore, if I update MasterData with "33333" from OUT sheet, that will update column E with StoreA with box number "8888".
If I run the macro at  "IN" sheet, "33333" column E will be replaced by "StoreB" and Column D with "2323".

Hope this info helps.



0
SiddharthRoutCommented:
Isn't that what my example is doing already?

If you run the macro from the The 'Out' Sheet then it is updating the values that are present in "Out" Sheet  and "MasterList". If they are not present in the masterlist then it is Adding those at the bottom. Isn't that what you want?

Sid
0
CartilloAuthor Commented:
Hi Sid,

The suggested code doesn't update the data into Masterdata. I've attached the sample Listing sheet. if I run the code at "OUT" sheet what I can see is only first row data from 'OUT" with empty cell at column A. Same goes at "IN' Sheet.  

>If you run the macro from the The 'Out' Sheet then it is updating the values that are present in "Out" Sheet  and "MasterList". If they are not present in the masterlist then it is Adding those at the bottom. Isn't that what you want?

Yes, you're right.
0
SiddharthRoutCommented:
>>>>I've attached the sample Listing sheet.

Sample missing.

Sid
0
CartilloAuthor Commented:
Hi,

Opps! sorry. Here's.
Listing-Sid.xls
0
SiddharthRoutCommented:
Ok, here is the BEFORE and AFTER Masterdata.xls.

'BEFORE' is before I run the macro and 'AFTER' is once the data is updated. Is this what you want?

Sid
MasterData---BEFORE.xls
MasterData---AFTER.xls
0
SiddharthRoutCommented:
If the above is correct then I will upload the new code.

Sid
0
CartilloAuthor Commented:
Hi,

I masterdata- before has been updated with "number" ( Column A), by right this number should not exist.
0
SiddharthRoutCommented:
I get the same results even if i delete those numbers :)

Sid
0
CartilloAuthor Commented:
Hi Sid,

Cool....
0
SiddharthRoutCommented:
Updated File

Sid

Code Used

Sub SendToMaster()
    Dim i As Long, ws1lastRow As Long, ws2LastRow As Long
    Dim wb1 As Workbook, wb2 As Workbook, ws1 As Worksheet, ws2 As Worksheet
    Dim aCell As Range, strColE As String, strSearch As String
    
    Application.ScreenUpdating = False
    
    On Error GoTo Whoa
    
    Set wb1 = ActiveWorkbook
    Set ws1 = ActiveSheet
    
    ws1lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    
    Set wb2 = Workbooks.Open("D:\Data\MasterData.xls")
    Set ws2 = wb2.Sheets("MasterList")
    
    Select Case ws1.Name
    Case "IN"
        strColE = "StoreB"
    Case "OUT"
        lastRowWs2 = ws1.Range("A" & Rows.Count).End(xlUp).Row
        strColE = "StoreA"
    End Select
    
    For i = 3 To ws1lastRow
        strSearch = ws1.Range("A" & i).Value
        
        Set aCell = ws2.Columns(1).Find(What:=strSearch, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        
        If Not aCell Is Nothing Then
            aCell.Offset(, 1).Value = ws1.Range("B" & i).Value
            aCell.Offset(, 2).Value = ws1.Range("C" & i).Value
            aCell.Offset(, 3).Value = ws1.Range("D" & i).Value
            aCell.Offset(, 4).Value = strColE
        Else
            ws2LastRow = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1
            ws2.Range("A" & i).Value = ws1.Range("A" & i).Value
            ws2.Range("B" & i).Value = ws1.Range("B" & i).Value
            ws2.Range("C" & i).Value = ws1.Range("C" & i).Value
            ws2.Range("D" & i).Value = ws1.Range("D" & i).Value
            ws2.Range("E" & i).Value = strColE
        End If
    Next i
    
OKLetsContinue:
    Application.DisplayAlerts = False
    wb2.Close savechanges:=True
    Application.DisplayAlerts = True
    
    Set ws2 = Nothing
    Set wb2 = Nothing
    Application.ScreenUpdating = True
    MsgBox "Done"
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume OKLetsContinue
End Sub

Open in new window

Lisiting.xls
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
CartilloAuthor Commented:
Hi Sid,

Thanks a lot for the fixed. But when I update new “number” from “IN” sheet, its override the existing data at Masterdata. Any chance to fix this?
0
CartilloAuthor Commented:
Hi Sid,

Hope you will consider my last request in this Q:D: 35246507
0
SiddharthRoutCommented:
Cartillo: Are you sure? I just tried it and it appends the data to the masterlist in case it is already not there.

Sid
0
CartilloAuthor Commented:
Hi Sid,

Sorry for the wrong update. Thanks a lot for the help.
0
SiddharthRoutCommented:
So is it sorted?

Sid
0
CartilloAuthor Commented:
Hi,

Thanks for the help Sid.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.