asked on

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

bromy2004

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

Cartillo

ASKER

Hi,

When I update data either in IN/Out sheet, Column E at MasterData workbook still having the old data.

Cartillo

ASKER

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.

bromy2004

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

Cartillo

ASKER

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

Cartillo

ASKER

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.

Cartillo

ASKER

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.

bromy2004

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

Cartillo

ASKER

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?

ASKER CERTIFIED SOLUTION

bromy2004

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Cartillo

ASKER

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

SOLUTION

bromy2004

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Cartillo

ASKER

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.

bromy2004

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)

Cartillo

ASKER

Hi,

Thanks a lot for helping me with this solution