Update data according to sheet selection.

Hi Experts,

I would like to request Experts help to modify module 1 and 2 in the “Listing” workbook. Currently Module 1 and 2 Module copy data from Listing Workbook to MasterData workbook. The problem is Data at Column E (MasterData WB) was not updated according to Module selection.

 If data gets updated by using “Out” sheet (Listing), Column E at MasterData need to be captured as “StoreA”. If using “IN” Sheet, Column E at MasterData workbook need to capture as “StroreB”. Hope Experts can help me to modify this script. Attached the workbook for Experts perusal.



Listing.xls
MasterData.xls
CartilloAsked:
Who is Participating?
 
bromy2004Commented:
OK. more bugs

New Code below
1. Line 40: strMasterLoc & "\MasterData.xls" returned "C:\Users\Nathan\Downloads\MasterData.xls\MasterData.xls"
    Which is clearly wrong
2. After Line 47: I've added in the Check if workbook is open, instead of failing on the Read Only

Option Explicit

Sub SendToMaster()
Const strMasterLoc As String = "C:\Users\Nathan\Downloads\MasterData.xls"

Dim i As Long
Dim lgFoundRow As Long

Dim wbkMaster As Workbook
Dim wbkListing As Workbook

Dim shtMaster As Worksheet
Dim shtListing As Worksheet

Dim rngMaster As Range
Dim rngListing As Range

Dim rngMatch As Range
Dim rngWorking As Range

Dim booWbkOpen As Boolean

Application.ScreenUpdating = False
On Error Resume Next





'''''''''''''''''''''''''''''''''''''''''''''''''''
'WORKBOOKS


Set wbkListing = ActiveWorkbook

'Set Master Workbook
Set wbkMaster = Workbooks("MasterData.xls")

If Err <> 0 Then
  Set wbkMaster = Workbooks.Open(strMasterLoc, ReadOnly:=False)
  booWbkOpen = False
Else
  'Set that the Workbook was already open
  booWbkOpen = True
End If

'''''''''''''''''''''''''''''''''''''''''''''''''''

'Check if the workbook was opened
'Alert User and Exit Sub
If wbkMaster Is Nothing Then
  MsgBox "MasterData workbook could not be found." & vbNewLine & "Please the file is located in " & strMasterLoc, vbOKOnly + vbInformation
  Exit Sub
End If

'Check if the workbook is open as 'Read Only'
'Alert user and Exit Sub
If wbkMaster.ReadOnly Then
  MsgBox "MasterData workbook can't be opened as read-only for data update. Try again later", vbOKOnly + vbInformation
  If Not booWbkOpen Then wbkMaster.Close (True)
  Exit Sub
End If



'''''''''''''''''''''''''''''''''''''''''''''''''''
'WORKSHEETS

'Get current sheet (Out/In)
Set shtListing = wbkListing.ActiveSheet

'Get Master Sheet
Set shtMaster = wbkMaster.Sheets("MasterList")
'''''''''''''''''''''''''''''''''''''''''''''''''''

'''''''''''''''''''''''''''''''''''''''''''''''''''
'RANGES
'Set Master Range
With shtMaster
  Set rngMaster = .Range(.Cells(3, 1), .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row, 5))
End With

With shtListing
  Set rngListing = .Range(.Cells(3, 1), .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row, 4))
End With
'''''''''''''''''''''''''''''''''''''''''''''''''''


Err.Clear

'''''''''''''''''''''''''''''''''''''''''''''''''''
'Populate Data

For Each rngWorking In rngListing.Rows

  'Get Found Row
  lgFoundRow = rngMaster.Columns(1).Find(rngWorking.Cells(1).Value, rngMaster.Cells(1), xlValues, xlWhole, xlByColumns, xlNext).Row
  
  'If Match not found
  If lgFoundRow = 0 Then
    'Value not Found
    'Range is New Row
    Set rngMatch = rngMaster.Rows(rngMaster.Rows.Count).Offset(1)
  Else
    'Value Found
    'Range is Matched Row
    Set rngMatch = Intersect(shtMaster.Rows(lgFoundRow), rngMaster)
  End If
  'Reset Found Row
  lgFoundRow = 0
  
  
  '''''''''''''''''''''''''''''''''''''''''''''''''''
  'Copy Data
  For i = 1 To 4
    'Fill the first 4 Rows
    'This can be expanded easily to accomidate more data
    rngMatch.Cells(i).Value = rngWorking.Cells(i).Value
  Next i
  
  'Add Store information to Column 5 (E) in Master
  rngMatch.Cells(5).Value = IIf(shtListing.Name = "OUT", "StoreA", "StoreB")
  '''''''''''''''''''''''''''''''''''''''''''''''''''
  
  
Next rngWorking
'''''''''''''''''''''''''''''''''''''''''''''''''''


'''''''''''''''''''''''''''''''''''''''''''''''''''
'Finish
'If workbook was NOT already open, Close it.
If Not booWbkOpen Then wbkMaster.Close (True)

Application.ScreenUpdating = True
'''''''''''''''''''''''''''''''''''''''''''''''''''

End Sub

Open in new window

0
 
bromy2004Commented:
What isn't working in Column E?

I had a quick look and it seemed to be working fine, although you had duplicate code.

I've only changed
="StoreA"

to
= IIf(shtListing.Name = "OUT", "StoreA", "StoreB")


Change Module2 code to
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


and change the Buttons to link to that Macro

Change Module1 to
Sub UpdateValues(ByRef Target As Range)
Dim DateStr As String

    If Target.Column = 1 Then
        Target.Offset(1, 0).Select
    End If
    If Target.Row < 3 Then Exit Sub
    If Not Application.Intersect(Target, Columns(1)) Is Nothing Then
        If Target.Cells.Count = 1 Then
          Target.Offset(, 1) = Environ("username")
          Target.Offset(, 2) = Now()
          DateStr = Format(Target.Offset(, 2).Value, "dd-mmm")
          Target.Offset(, 3) = Target.Offset(-1, 3)
        End If
    End If
End Sub

Open in new window


and Change Sheet1 & Sheet2 Code to
Private Sub Worksheet_Change(ByVal Target As Range)
Module1.UpdateValues Target
End Sub

Open in new window

0
 
CartilloAuthor Commented:
Hi,

When I update data either in IN/Out sheet, Column E at MasterData workbook still having the old data.
0
Cloud Class® Course: Certified Penetration Testing

This CPTE Certified Penetration Testing Engineer course covers everything you need to know about becoming a Certified Penetration Testing Engineer. Career Path: Professional roles include Ethical Hackers, Security Consultants, System Administrators, and Chief Security Officers.

 
CartilloAuthor Commented:
Hi,

Perhaps my explanation may not sufficient, here's what supposedly should happen if we update data from OUT and IN sheet.

If data updated from OUT sheet, Column E at Master Data sheet should be updated as "StroreA". If "IN" sheet  was used to updata data, than Column E will be updated as "StoreB". All data has been updated properly except when we update an existing number in the Master Data Sheet. All other columns captured the new updates except  Data in Column E. Hope you can help me to fix this.
0
 
bromy2004Commented:
In your macro, you've told it not to.

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

Open in new window


Also the Offset(,1) keeps sending it out to the right

As per my last comment with the code changes, but change Module 2 to

Option Explicit

Sub SendToMaster()
Dim i As Long
Dim lgFoundRow As Long

Dim wbkMaster As Workbook
Dim wbkListing As Workbook

Dim shtMaster As Worksheet
Dim shtListing As Worksheet

Dim rngMaster As Range
Dim rngListing As Range

Dim rngMatch As Range
Dim rngWorking As Range

Dim booWbkOpen As Boolean

'Application.ScreenUpdating = False
On Error Resume Next





'''''''''''''''''''''''''''''''''''''''''''''''''''
'WORKBOOKS

'Set Master Workbook
Set wbkMaster = Workbooks("MasterData.xls")

If Err <> 0 Then
  Set wbkMaster = Workbooks.Open("D:\Data\MasterData.xls")
  booWbkOpen = True
Else
  'Set that the Workbook was already open
  booWbkOpen = True
End If


Set wbkListing = ActiveWorkbook
'''''''''''''''''''''''''''''''''''''''''''''''''''


'Check if the workbook is open as 'Read Only'
'Alert user and Exit Sub
If wbkMaster.ReadOnly Then
  MsgBox "MasterData workbook can't be opened as read-only for data update. Try again later"
  If Not booWbkOpen Then wbkMaster.Close (True)
  Exit Sub
End If



'''''''''''''''''''''''''''''''''''''''''''''''''''
'WORKSHEETS

'Get current sheet (Out/In)
Set shtListing = wbkListing.ActiveSheet

'Get Master Sheet
Set shtMaster = wbkMaster.Sheets("MasterList")
'''''''''''''''''''''''''''''''''''''''''''''''''''

'''''''''''''''''''''''''''''''''''''''''''''''''''
'RANGES
'Set Master Range
With shtMaster
  Set rngMaster = .Range(.Cells(3, 1), .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row, 5))
End With

With shtListing
  Set rngListing = .Range(.Cells(3, 1), .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row, 4))
End With
'''''''''''''''''''''''''''''''''''''''''''''''''''


Err.Clear

'''''''''''''''''''''''''''''''''''''''''''''''''''
'Populate Data

For Each rngWorking In rngListing.Rows

  'Get Found Row
  lgFoundRow = rngMaster.Columns(1).Find(rngWorking.Cells(1).Value, rngMaster.Cells(1), xlValues, xlWhole, xlByColumns, xlNext).Row
  
  'If Match not found
  If lgFoundRow = 0 Then
    'Value not Found
    'Range is New Row
    Set rngMatch = rngMaster.Rows(rngMaster.Rows.Count).Offset(1)
  Else
    'Value Found
    'Range is Matched Row
    Set rngMatch = Intersect(shtMaster.Rows(lgFoundRow), rngMaster)
  End If
  'Reset Found Row
  lgFoundRow = 0
  
  
  '''''''''''''''''''''''''''''''''''''''''''''''''''
  'Copy Data
  For i = 1 To 4
    'Fill the first 4 Rows
    'This can be expanded easily to accomidate more data
    rngMatch.Cells(i).Value = rngWorking.Cells(i).Value
  Next i
  
  'Add Store information to Column 5 (E) in Master
  rngMatch.Cells(5).Value = IIf(shtListing.Name = "OUT", "StoreA", "StoreB")
  '''''''''''''''''''''''''''''''''''''''''''''''''''
  
  
Next rngWorking
'''''''''''''''''''''''''''''''''''''''''''''''''''


'''''''''''''''''''''''''''''''''''''''''''''''''''
'Finish
'If workbook was NOT already open, Close it.
If Not booWbkOpen Then wbkMaster.Close (True)

'Application.ScreenUpdating = True
'''''''''''''''''''''''''''''''''''''''''''''''''''

End Sub

Open in new window



I have reworked it a bit to make it a bit more readable.
And when you make a macro comment extensively,
Even if it looks weird, it makes it easier to read months down the track when you try to figure out how older macros work
0
 
CartilloAuthor Commented:
Hi

I'm not sure why the workbook nor allowing me to update the data even though the workbook is closed. The message box keeps active:

 "MsgBox "MasterData workbook can't be opened as read-only for data update. Try again later"

Please advice
0
 
CartilloAuthor Commented:
Hi bromy2004,

I need your favor. Is that possible to modify the MasterData workbook  procedure.

If WB is Closed: Open the WB, update the data and close
If WB is Open: Update the data, do not close

Hope you will with this request.
0
 
CartilloAuthor Commented:

Hi bromy2004,

The message "MasterData workbook can't be opened as read-only for data update. Try again later" mainly pop up because of my mistake. Please ignore this comment. After I tested with the new code, I noticed the workbook (Masterdata) open but the data was not updated from Listing WB to MasterData Workbook. Please help.
0
 
bromy2004Commented:
Hi Cartillo,

A couple of bugs were in there.
The message showed up because the file wasn't in the right location (Hadn't actually tested that part, only tested with the workbook open)
It didn't update properly because shtListing was actually the Master Sheet (Because 'Set wbkListing=ActiveWorkbook', after the MasterBook is opened, the activesheet is the MasterSheet)
It didn't close properly because booWbkOpen=True was on both paths of the IF statement. Been fixed,

Change module2 Code to
Option Explicit

Sub SendToMaster()
Const strMasterLoc As String = "C:\Users\Nathan\Downloads\MasterData.xls"

Dim i As Long
Dim lgFoundRow As Long

Dim wbkMaster As Workbook
Dim wbkListing As Workbook

Dim shtMaster As Worksheet
Dim shtListing As Worksheet

Dim rngMaster As Range
Dim rngListing As Range

Dim rngMatch As Range
Dim rngWorking As Range

Dim booWbkOpen As Boolean

Application.ScreenUpdating = False
On Error Resume Next





'''''''''''''''''''''''''''''''''''''''''''''''''''
'WORKBOOKS


Set wbkListing = ActiveWorkbook

'Set Master Workbook
Set wbkMaster = Workbooks("MasterData.xls")

If Err <> 0 Then
  Set wbkMaster = Workbooks.Open(strMasterLoc & "\MasterData.xls", ReadOnly:=False)
  booWbkOpen = False
Else
  'Set that the Workbook was already open
  booWbkOpen = True
End If

'''''''''''''''''''''''''''''''''''''''''''''''''''


'Check if the workbook is open as 'Read Only'
'Alert user and Exit Sub
If wbkMaster.ReadOnly Then
  MsgBox "MasterData workbook can't be opened as read-only for data update. Try again later"
  If Not booWbkOpen Then wbkMaster.Close (True)
  Exit Sub
End If



'''''''''''''''''''''''''''''''''''''''''''''''''''
'WORKSHEETS

'Get current sheet (Out/In)
Set shtListing = wbkListing.ActiveSheet

'Get Master Sheet
Set shtMaster = wbkMaster.Sheets("MasterList")
'''''''''''''''''''''''''''''''''''''''''''''''''''

'''''''''''''''''''''''''''''''''''''''''''''''''''
'RANGES
'Set Master Range
With shtMaster
  Set rngMaster = .Range(.Cells(3, 1), .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row, 5))
End With

With shtListing
  Set rngListing = .Range(.Cells(3, 1), .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row, 4))
End With
'''''''''''''''''''''''''''''''''''''''''''''''''''


Err.Clear

'''''''''''''''''''''''''''''''''''''''''''''''''''
'Populate Data

For Each rngWorking In rngListing.Rows

  'Get Found Row
  lgFoundRow = rngMaster.Columns(1).Find(rngWorking.Cells(1).Value, rngMaster.Cells(1), xlValues, xlWhole, xlByColumns, xlNext).Row
  
  'If Match not found
  If lgFoundRow = 0 Then
    'Value not Found
    'Range is New Row
    Set rngMatch = rngMaster.Rows(rngMaster.Rows.Count).Offset(1)
  Else
    'Value Found
    'Range is Matched Row
    Set rngMatch = Intersect(shtMaster.Rows(lgFoundRow), rngMaster)
  End If
  'Reset Found Row
  lgFoundRow = 0
  
  
  '''''''''''''''''''''''''''''''''''''''''''''''''''
  'Copy Data
  For i = 1 To 4
    'Fill the first 4 Rows
    'This can be expanded easily to accomidate more data
    rngMatch.Cells(i).Value = rngWorking.Cells(i).Value
  Next i
  
  'Add Store information to Column 5 (E) in Master
  rngMatch.Cells(5).Value = IIf(shtListing.Name = "OUT", "StoreA", "StoreB")
  '''''''''''''''''''''''''''''''''''''''''''''''''''
  
  
Next rngWorking
'''''''''''''''''''''''''''''''''''''''''''''''''''


'''''''''''''''''''''''''''''''''''''''''''''''''''
'Finish
'If workbook was NOT already open, Close it.
If Not booWbkOpen Then wbkMaster.Close (True)

Application.ScreenUpdating = True
'''''''''''''''''''''''''''''''''''''''''''''''''''

End Sub

Open in new window


Change the Constant strMasterLoc value to the Path for the MasterWorkbook
0
 
CartilloAuthor Commented:
Hi,

I can’t open the workbook and its keep-on prompting “read only message box” even though the workbook is closed. How to fix this?
0
 
CartilloAuthor Commented:
Hi,

Thanks for the revised code. Have tested, what happen was only last row of each sheet (OUT/IN) copied at MasterData. Other data were not copied. I have attached the sample data (Listing) that I tested for your kind perusal. Please assist.

Listing.xls
0
 
bromy2004Commented:
Insert

    Set rngMaster = rngMaster.Resize(rngMaster.Rows.Count + 1, rngMaster.Columns.Count)

Open in new window


after Line 103
Set rngMatch = rngMaster.Rows(rngMaster.Rows.Count).Offset(1)

Open in new window

0
 
CartilloAuthor Commented:
Hi,

Thanks a lot for the revised code. How to set the first data row starts at row 3 (A3), currently the data copied at row 4 onwards. Other functions are perfect.
0
 
bromy2004Commented:
I'm not near my computer at the moment. But if you look at the code near the comments 'RANGES
The lines with .Range(.Cells(3, 1) says
The top left hand cell of data is row 3 column 1 ("A3")

The only reason if it pastes at row 4 is if your master is empty. (starting cell of A3 offset (because match not found) to A4)
0
 
CartilloAuthor Commented:
Hi,

Thanks a lot for helping me with this solution
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.