Hub workbook as a medium to multiple workbooks

[DWRgt2885]

Hi all!

I've created a user form in which I submit data on orders i'm following up on. 5 other co workers have a copy of that workbook. Every time we click the "Submit" button on the user form, it adds the form data to the next blank row in the current workbook, but it ALSO adds the form data to the next blank row in a closed workbook called "Hub". The idea is that we can all update the "Hub" sheet with out running into a "read only" issue.

Now, i need to take the data from the "Hub" sheet and update all the User workbooks with any new data that was added to "Hub". I'd like this to happen when a user opens his/her User Form.

I've messed around with a few different codes, but they seem overly complicated when I feel like this be pretty simply.

Copy used range from Hub > add data to current workbook starting in first blank cell in Column A

I read the below article, and my main concern is the range address differs every day. My goal is to have every User workbook updated as often as possible with data from the "Hub" workbook[h=1]Copy range from closed workbook and paste into active workbook[/h]
I like the below code, but i don't want anyone to have to manually select the file, could someone guide me into modifying this to a specific workbook or point me in a general direction?

[Sub ImportDatafromcloseworkbook()'Update 20150707
Dim xWb As Workbook
Dim xAddWb As Workbook
Dim xRng1 As Range
Dim xRng2 As Range
Set xWb = Application.ActiveWorkbook
xTitleId = "KutoolsforExcel"
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xlsa"
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
Application.Workbooks.Open .SelectedItems(1)
Set xAddWb = Application.ActiveWorkbook
Set xRng1 = sh4.Range(Rows.Count, 1).End(xlUp).Row
xWb.Activate
Set xRng2 = Range("A1").End(xlDown).Offset(1, 0).Select
xRng1.Copy xRng2
xRng2.CurrentRegion.EntireColumn.AutoFit
xAddWb.Close False
End If
End With
End Sub]

 

[dmt32]

Replace the WorkBook_Open event with following :

Private Sub Workbook_Open()
    
    Dim WS As Worksheet
    
    With Application
        .ScreenUpdating = False: .DisplayAlerts = False
    End With
    
    On Error Resume Next
    Set WS = Worksheets("Order Status")
    strPwd = "2885"
    With ActiveSheet
        .Protect Password:=strPwd
        
        .ShowAllData
        .Protect Contents:=True, AllowFiltering:=True, _
        userinterfaceonly:=True, Password:=strPwd
        
    End With
    On Error GoTo 0
    
    frmOrders.Show
    
'Update Workbook with HUB DATA
    RefreshFromHub "C:\Users\DReardon\Desktop\Hub Folder\HUB.xlsm"
    UpdateData
    
    
    With Application
        .ScreenUpdating = True: .DisplayAlerts = True: .Visible = True
    End With
End Sub

Comment out the On Error line in the RefreshFromHub code to disable it

'On Error GoTo exitsub

Go back to the workbook open event place the cursor towards top of code & press F5 this will run the event
Assuming you get the error show the line code stops at.

Dave

 

[DWRgt2885]

It's odd, i commented out the "on error" line, ran the code and still got the error for Type Mismatch. But, the code doesn't stop anywhere? Prior to this last update, and currently, it still does what i want it to do, but the Type mismatch pops up anyway.

 

[dmt32]

Hi,
Seems I posted the wrong updated code I was playing with

Try this:

Sub RefreshFromHub(ByVal FileName As String, Optional ByVal wbPassword As String)


    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:=True, 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

If the error persists then comment out the On Error line & see where code breaks.


Open Event

Private Sub Workbook_Open()
    
    frmOrders.Show
    
'Update Workbook with HUB DATA
    RefreshFromHub "C:\Users\DReardon\Desktop\Hub Folder\HUB.xlsm"
    UpdateData
    
End Sub

Dave

 

[DWRgt2885]

Hi Dave,
Thanks again. Same exact effect taking place. Run code with error line commented out, type mismatch, code isn't breaking, and data is importing correctly... Is there a way to code something to just not show the Mismatch pop up? It's working, but i don't need the pop up