PDA

View Full Version : Synchornize Excel sheets



jack nt
09-25-2011, 06:49 PM
It is easy to synchronize Sheets in 2 WorkBooks

Consider 2 WorkBook WB1 and WB2 on 2 PC. There are 2 same Sheets in each one.

1. Create a DB.mdb with Table1 and Table2 on Server or shared folder
2. Convert data from WB1.Sheet1 to Table1 of DB.mdb
3. Convert data from Table1 to Sheet2
and do similarly whith WB2.Sheet2

Use the following LetMDB to convert XLS to MDB and GetMDB to convert MDB to XLS

Public Sub LetMDB(Sh As Object, FileName$, TableName$)
Dim i As Long, j As Integer, lastRow As Long
lastRow = xdLastRow(Sh, NUM_ROWS_XLS)
'-------------------------------
Dim strConect$, RS As Object
On Error GoTo sthWrong
strConect = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & FileName & ";"
Set RS = CreateObject("adodb.recordset")
RS.Open "DELETE * FROM " & TableName, strConect, 0, 2, 1
RS.Open "SELECT * FROM " & TableName, strConect, 0, 2, 1
With Sh
For i = 1 To lastRow
RS.AddNew
If Application.CountA(.Cells(i, 1).EntireRow) > 0 Then
For j = 1 To NUM_FIELDS_MDB
If Cells.Item(i, j) <> vbNullString Then
RS.Fields(j - 1) = .Cells.Item(i, j) '.FormulaR1C1
End If
Next j
End If
RS.Update
Next
RS.Close
End With
Set RS = Nothing
End Sub

Public Sub GetMDB(Sh As Object, FileName$, TableName$)
Application.ScreenUpdating = False
Dim i As Long, j As Integer
Dim strConect$, RS As Object
strConect = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & FileName & ";"
Set RS = CreateObject("adodb.recordset")
RS.Open "SELECT * FROM " & TableName, strConect, 0, 1, 1
With RS
If Not .EOF Then
.MoveFirst
i = 1
Sh.Cells.ClearContents 'clear old data in sh
Do Until .EOF
For j = 0 To NUM_FIELDS_MDB - 1
If Not IsNull(.Fields(j)) Then
Sh.Cells.Item(i, j + 1).FormulaR1C1 = CStr(.Fields(j))
End If
Next
.MoveNext
i = i + 1
Loop
End If
.Close
End With
Set RS = Nothing
Application.ScreenUpdating = True
End Sub

jack nt
09-25-2011, 07:38 PM
If you dislike to insert codes to workbook you can use the attached file to synchronize

jack nt
09-25-2011, 07:57 PM
sory for not attaching 2 files, so please use this attached