Multi-Workbook Data Sync

' Multi-Workbook Data Sync
' Place this code in the master workbook's Worksheet module

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Trigger sync when specific columns are modified
    On Error GoTo ErrorHandler

    ' Define sync columns (A and B)
    Dim syncRangeA As Range
    Dim syncRangeB As Range
    Set syncRangeA = Me.Range("A:A")
    Set syncRangeB = Me.Range("B:B")

    ' Check if changed cell is in sync range
    If Not Intersect(Target, syncRangeA) Is Nothing Or _
       Not Intersect(Target, syncRangeB) Is Nothing Then

        Application.EnableEvents = False

        ' Call sync procedure
        Call SyncToSecondaryWorkbook(Target)

        Application.EnableEvents = True
    End If

    Exit Sub

ErrorHandler:
    Application.EnableEvents = True
    MsgBox "Error during sync: " & Err.Description, vbCritical
End Sub

Sub SyncToSecondaryWorkbook(ByVal changedCell As Range)
    ' Sync changed data to secondary workbook
    On Error GoTo ErrorHandler

    ' Define secondary workbook path
    Dim secondaryPath As String
    secondaryPath = ThisWorkbook.Path & "SecondaryWorkbook.xlsx"

    ' Check if file exists
    If Dir(secondaryPath) = "" Then
        MsgBox "Secondary workbook not found at: " & secondaryPath, vbExclamation
        Exit Sub
    End If

    ' Open secondary workbook (or reference if already open)
    Dim secondaryWB As Workbook
    Dim isOpen As Boolean
    isOpen = False

    ' Check if workbook is already open
    Dim wb As Workbook
    For Each wb In Application.Workbooks
        If wb.FullName = secondaryPath Then
            Set secondaryWB = wb
            isOpen = True
            Exit For
        End If
    Next wb

    ' Open if not already open
    If Not isOpen Then
        Set secondaryWB = Workbooks.Open(secondaryPath, UpdateLinks:=False, ReadOnly:=False)
    End If

    ' Find matching row in secondary workbook
    Dim secondaryWS As Worksheet
    Set secondaryWS = secondaryWB.Sheets(1)

    Dim matchRow As Long
    matchRow = 0

    ' Get identifier from column A of changed row
    Dim identifier As Variant
    identifier = Me.Cells(changedCell.Row, 1).Value

    ' Find matching identifier in secondary workbook
    Dim lastRow As Long
    lastRow = secondaryWS.Cells(secondaryWS.Rows.Count, "A").End(xlUp).Row

    Dim i As Long
    For i = 2 To lastRow
        If secondaryWS.Cells(i, 1).Value = identifier Then
            matchRow = i
            Exit For
        End If
    Next i

    ' If no match found, add new row
    If matchRow = 0 Then
        matchRow = lastRow + 1
        secondaryWS.Cells(matchRow, 1).Value = identifier
    End If

    ' Sync the changed column
    If changedCell.Column = 1 Then ' Column A
        secondaryWS.Cells(matchRow, 1).Value = changedCell.Value
    ElseIf changedCell.Column = 2 Then ' Column B
        secondaryWS.Cells(matchRow, 2).Value = changedCell.Value
    End If

    ' Add timestamp
    secondaryWS.Cells(matchRow, 3).Value = Now

    ' Save and close if we opened it
    If Not isOpen Then
        secondaryWB.Close SaveChanges:=True
    End If

    Exit Sub

ErrorHandler:
    If Not isOpen And Not secondaryWB Is Nothing Then
        secondaryWB.Close SaveChanges:=False
    End If
    MsgBox "Error syncing to secondary workbook: " & Err.Description, vbCritical
End Sub

Sub ManualFullSync()
    ' Manually trigger full sync of all data
    On Error GoTo ErrorHandler

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Dim lastRow As Long
    lastRow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row

    Dim i As Long
    For i = 2 To lastRow
        Call SyncToSecondaryWorkbook(Me.Cells(i, 1))
    Next i

    Application.EnableEvents = True
    Application.ScreenUpdating = True

    MsgBox "Full sync completed successfully!", vbInformation
    Exit Sub

ErrorHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    MsgBox "Error during full sync: " & Err.Description, vbCritical
End Sub