Compare and Merge unshared workbooks having exactly Same file structure.

[mathsbeauty]

Hello! Some copies of excel workbooks are made using save as option for data entry purpose. Each copy has same file structure because they are created using save as option. Is it possible to merge them (preferably preserving the macros) ? The workbooks are not shared because they were protected sheets and so macros wont run.

 

[Ruddles]

Something like this:-

Option Explicit'
Public Sub MergeWorkbooks()
'
  Dim strWorkbook1 As String
  Dim wb1 As Workbook
  Dim ws1 As Worksheet
  Dim oCell1 As Range
  Dim strWorkbook2 As String
  Dim wb2 As Workbook
  Dim ws2 As Worksheet
  Dim oCell2 As Range
'  
[COLOR=#FF0000]  Dim wsPointer As Integer
[/COLOR]'
  Dim iChanged As Long
'
  Dim strMessage As String
'
  strWorkbook1 = Application.GetOpenFilename(FileFilter:="Excel workbooks (*.xl*), *.xl*")
  If strWorkbook1 = "False" Then Exit Sub
  strWorkbook2 = Application.GetOpenFilename(FileFilter:="Excel workbooks (*.xl*), *.xl*")
  If strWorkbook2 = "False" Then Exit Sub
'
  Application.ScreenUpdating = False
'
  Set wb1 = Workbooks.Open(strWorkbook1)
  Set wb2 = Workbooks.Open(strWorkbook2)
'
[COLOR=#FF0000]  For wsPointer = 1 To wb1.Worksheets.Count
'    
    Set ws1 = wb1.Sheets(wsPointer)
    Set ws2 = wb2.Sheets(wsPointer)
[/COLOR]'  
    iChanged = 0
    For Each oCell1 In ws1.UsedRange
      Set oCell2 = ws2.Range(oCell1.Address)
      If IsEmpty(oCell2) Then
        If Not IsEmpty(oCell1) Then
          oCell1.Copy Destination:=oCell2
          iChanged = iChanged + 1
        End If
      End If
    Next oCell1
'  
[COLOR=#FF0000]  Next wsPointer
[/COLOR]'
  Application.ScreenUpdating = True
'
  strMessage = vbCrLf _
       & "Values from " & wb1.Name & " have been overlaid onto " & wb2.Name & "." _
       & Space(10) & vbCrLf & vbCrLf _
       & "Number of cells updated: " & iChanged _
       & Space(10) & vbCrLf & vbCrLf _
       & "Please save " & wb2.Name & " if you want to preserve these changes." _
       & Space(10)
'
  wb1.Close savechanges:=False
'
  MsgBox strMessage, vbOKOnly + vbExclamation
'
End Sub

The changes are highlighted in red. See how that goes.

Important: test with copies of your data!

 

[benningtonr]

It is doing the same thing, 0 cells updated, and the changes are not coming over.

I have two spread sheets, they are for tracking ip addresses at my work.
I had two people editing two different spread sheets so now I need to merge then into one, if at all possible
some data on each is the same, the structure of each is identical, but some of the data on each is different.

Thanks for your help

 

[Ruddles]

Sorry, move the line iChanged = 0 so that it appears before the line which reads For wsPointer = 1 To wb1.Worksheets.Count and try it again.

 

[Needanswers]

Try this:-

[FONT=Fixedsys]Option Explicit[/FONT]

[FONT=Fixedsys]Public Sub MergeWorkbooks()[/FONT]

[FONT=Fixedsys] Dim strWorkbook1 As String[/FONT]
[FONT=Fixedsys] Dim wb1 As Workbook[/FONT]
[FONT=Fixedsys] Dim ws1 As Worksheet[/FONT]
[FONT=Fixedsys] Dim oCell1 As Range[/FONT]

[FONT=Fixedsys] Dim strWorkbook2 As String[/FONT]
[FONT=Fixedsys] Dim wb2 As Workbook[/FONT]
[FONT=Fixedsys] Dim ws2 As Worksheet[/FONT]
[FONT=Fixedsys] Dim oCell2 As Range[/FONT]

[FONT=Fixedsys] Dim iChanged As Long[/FONT]

[FONT=Fixedsys] Dim strMessage As String[/FONT]

[FONT=Fixedsys] strWorkbook1 = Application.GetOpenFilename(FileFilter:="Excel workbooks (*.xl*), *.xl*")[/FONT]
[FONT=Fixedsys] If strWorkbook1 = "False" Then Exit Sub[/FONT]

[FONT=Fixedsys] strWorkbook2 = Application.GetOpenFilename(FileFilter:="Excel workbooks (*.xl*), *.xl*")[/FONT]
[FONT=Fixedsys] If strWorkbook2 = "False" Then Exit Sub[/FONT]

[FONT=Fixedsys] Application.ScreenUpdating = False[/FONT]

[FONT=Fixedsys] Set wb1 = Workbooks.Open(strWorkbook1)[/FONT]
[FONT=Fixedsys] Set ws1 = wb1.Sheets(1)[/FONT]

[FONT=Fixedsys] Set wb2 = Workbooks.Open(strWorkbook2)[/FONT]
[FONT=Fixedsys] Set ws2 = wb2.Sheets(1)[/FONT]

[FONT=Fixedsys] iChanged = 0[/FONT]
[FONT=Fixedsys] For Each oCell1 In ws1.UsedRange[/FONT]
[FONT=Fixedsys]   Set oCell2 = ws2.Range(oCell1.Address)[/FONT]
[FONT=Fixedsys]   If IsEmpty(oCell2) Then[/FONT]
[FONT=Fixedsys]     If Not IsEmpty(oCell1) Then[/FONT]
[FONT=Fixedsys]       oCell1.Copy Destination:=oCell2[/FONT]
[FONT=Fixedsys]       iChanged = iChanged + 1[/FONT]
[FONT=Fixedsys]     End If[/FONT]
[FONT=Fixedsys]   End If[/FONT]
[FONT=Fixedsys] Next oCell1[/FONT]

[FONT=Fixedsys] Application.ScreenUpdating = True[/FONT]

[FONT=Fixedsys] strMessage = vbCrLf _[/FONT]
[FONT=Fixedsys]      & "Values from " & wb1.Name & " have been overlaid onto " & wb2.Name & "." _[/FONT]
[FONT=Fixedsys]      & Space(10) & vbCrLf & vbCrLf _[/FONT]
[FONT=Fixedsys]      & "Number of cells updated: " & iChanged _[/FONT]
[FONT=Fixedsys]      & Space(10) & vbCrLf & vbCrLf _[/FONT]
[FONT=Fixedsys]      & "Please save " & wb2.Name & " if you want to preserve these changes." _[/FONT]
[FONT=Fixedsys]      & Space(10)[/FONT]

[FONT=Fixedsys] wb1.Close savechanges:=False[/FONT]

[FONT=Fixedsys] MsgBox strMessage, vbOKOnly + vbExclamation[/FONT]

[FONT=Fixedsys]End Sub[/FONT]

Open a new workbook, paste this code into a new general code module and run it.

It will prompt you to open two workbooks, then it will copy the cells from workbook1.sheet1 to workbook2.sheet1 if the cell in workbook2.sheet1 is empty.

Workbook1 is not changed: all the changes are made to workbook2 but workbook2 isn't saved back to disk - you have to do that manually. Any macros in workbook2 are left untouched.

See if that's any use to you. Shout if you need any changes.

omg This was a lifesaver. I just need one thing though. How can Imodify this to compare a batch of files with one file. Something along the lines of
strWorkbook1 = Application.GetOpenFilename(FileFilter:="Excel workbooks (*.xl*), *.xl*",Multiselect:=true)

Dont know where to go from here... Thanks in advance

 

[Ruddles]

You need to save the files names selected in the first File Open dialog in an array, then instead of opening just one file, you cycle through the array opening each file in turn.

Try this:-

Option Explicit
Public Sub MergeWorkbooks()

 Dim strWorkbookArray As Variant
 
 Dim strWorkbook1 As Variant
 Dim wb1 As Workbook
 Dim ws1 As Worksheet
 Dim oCell1 As Range

 Dim strWorkbook2 As String
 Dim wb2 As Workbook
 Dim ws2 As Worksheet
 Dim oCell2 As Range

 Dim iChanged As Long
 Dim strMessage As String

 strWorkbookArray = Application.GetOpenFilename(FileFilter:="Excel workbooks (*.xl*), *.xl*", MultiSelect:=True)
 If Not IsArray(strWorkbookArray) Then Exit Sub

 strWorkbook2 = Application.GetOpenFilename(FileFilter:="Excel workbooks (*.xl*), *.xl*")
 If strWorkbook2 = "False" Then Exit Sub

 Application.ScreenUpdating = False

 Set wb2 = Workbooks.Open(strWorkbook2)
 Set ws2 = wb2.Sheets(1)
 iChanged = 0

 For Each strWorkbook1 In strWorkbookArray

   Set wb1 = Workbooks.Open(strWorkbook1)
   Set ws1 = wb1.Sheets(1)
  
   For Each oCell1 In ws1.UsedRange
     Set oCell2 = ws2.Range(oCell1.Address)
     If IsEmpty(oCell2) Then
       If Not IsEmpty(oCell1) Then
         oCell1.Copy Destination:=oCell2
         iChanged = iChanged + 1
       End If
     End If
   Next oCell1

   wb1.Close savechanges:=False

 Next strWorkbook1
 
 Application.ScreenUpdating = True

 strMessage = vbCrLf _
      & "Values from 'merged' workbooks have been overlaid onto " & wb2.Name & "." _
      & Space(10) & vbCrLf & vbCrLf _
      & "Number of cells updated: " & iChanged _
      & Space(10) & vbCrLf & vbCrLf _
      & "Please save " & wb2.Name & " if you want to preserve these changes." _
      & Space(10)

 MsgBox strMessage, vbOKOnly + vbInformation

End Sub

 

[Needanswers]

Thank you so much for coming back to this old thread Ruddles, and providing me a solution.

I hoped I could just do the easy way out and just choose multiple files like "compare and merge". But I need to get my programming hat back on: (Ive only used Java...9 years ago)

Pray tell: How do I put my files in an array? I read up on websites about VBA arrays this but Its french to me.

 

[Needanswers]

OMG Duh!! soory Thanks again Mr . Ruddles

 

[Ruddles]

Ah, you realised that I posted the code to handle multiple files!

But this is something completely separate to the question you PM'd me about, yes?