Hi All,
I have a SOURCE workbook I use for Order Management and when I submit the form data to the sheet, it also submits it to a closed, HUB workbook on a shared drive. There are 6 other people using this. The HUB workbook has everyone's work. When you open the SOURCE workbook it will ask you if you would like to import data from HUB. The idea is that it will only import rows that have new data. Currently, when this is launched it imports all the rows, then removes the duplicates. It's messy, slow, and i don't think it is importing the most recent data. The last column of these sheets display a time stamp on each row (Last Modified).
My Question:
Is there a way to import the data from the HUB to the SOURCE so everyone has the most up to date information? Below is the code i'm using to do the import. Any help or guidance would be greatly appreciated. Thank you!
I have a SOURCE workbook I use for Order Management and when I submit the form data to the sheet, it also submits it to a closed, HUB workbook on a shared drive. There are 6 other people using this. The HUB workbook has everyone's work. When you open the SOURCE workbook it will ask you if you would like to import data from HUB. The idea is that it will only import rows that have new data. Currently, when this is launched it imports all the rows, then removes the duplicates. It's messy, slow, and i don't think it is importing the most recent data. The last column of these sheets display a time stamp on each row (Last Modified).
My Question:
Is there a way to import the data from the HUB to the SOURCE so everyone has the most up to date information? Below is the code i'm using to do the import. Any help or guidance would be greatly appreciated. Thank you!
Code:
Dim wbHub As Workbook, wsOrderStatus As Worksheet
Dim CopyFromRange As Range, CopyToRange As Range
Dim NextRow As Long
Const wsPassword As String = "2885"
'On Error GoTo exitsub
Set wsOrderStatus = ThisWorkbook.Sheets("Order Status")
If Not Dir(fileName, vbDirectory) = vbNullString Then
Application.ScreenUpdating = False
With wsOrderStatus
.Unprotect Password:=wsPassword
If .FilterMode Then .ShowAllData
NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
Set CopyToRange = .Cells(NextRow, 1)
End With
Set wbHub = Application.Workbooks.Open(fileName, ReadOnly:=False, Password:=wbPassword)
With wbHub.Sheets(1).UsedRange
Set CopyFromRange = .Offset(1, 0).Resize(.Rows.Count - 1)
End With
CopyFromRange.Copy CopyToRange
CopyToRange.CurrentRegion.EntireColumn.AutoFit
wbHub.Close False
Else
Err.Raise 53
End If
Set wbHub = Nothing
exitsub:
If Not wbHub Is Nothing Then wbHub.Close False
wsOrderStatus.Protect Password:=wsPassword, Contents:=True, _
AllowFiltering:=True, Userinterfaceonly:=True
Application.ScreenUpdating = True
If Err > 0 Then MsgBox (Error(Err)), 64, "Error"
End Sub