Data Comparison between master workbook and another workbook

[klpw]

Hi all,

I try to create a workbook which copy and paste row data from master workbook to another workbook starting from column C. When new row data is added in master workbook, the excel vba will compare if the data is already existed in another workbook, if no, then the new row data needs to be copied and pasted automatically to the last existing row in another workbook. May I know how can I achieve this? Please see attached for my code.

[SamT]

This is the code from the attached. There is no data in the book

Sub Run()
Dim Sheet1 As Worksheet
Dim lRow As Integer
Dim cell As Integer
'Dim Sheet2 As Worksheet
Dim b As Workbook

Set b = Workbooks.Open("C:\Users\maggie\Desktop\trial.xlsx")
b.Sheets("Sheet1").Select

lRow = Range("A" & Rows.Count).End(xlUp).Row
For Each cell In Range(Cells(1, "B"), Cells(1, 2))
Union(Range("A1:A" & lRow), Range(Cells(1, cell.Column), Cells(lRow, cell.Column))).Copy
Sheets.Add
ActiveSheet.Name = cell.Value
Range("A1").PasteSpecial
Sheets("Master").Select
Next cell

Application.CutCopyMode = False

b.Sheets("Sheet1").Range("A:Z").Copy Destination:=ThisWorkbook.Sheets("Sheet1").Range("C:Z")
b.Close
End Sub

[SamT]

I am trying to consider what you are wanting. I commented your code to help me do that.

I could not do it.
Here is the code with my comments

Sub Run()
Dim Sht1 As Worksheet 'Sheet1 is already a Sheet Object in Most Workbooks
Dim lRow As Integer
Dim Cel As Range 'Do not use VBA Keywords as Variable Names
Dim b As Workbook

Set b = Workbooks.Open("C:\Users\maggie\Desktop\trial.xlsx")
b.Sheets("Sheet1").Select

lRow = Range("A" & Rows.Count).End(xlUp).Row

'Specify sheet. This might be b.Sheets("Sheet1")
For Each Cel In Range("B1") 'Range(Cells(1, "B"), Cells(1, 2)) is only Range("B1")

'This Union is Range("A1:B" & lRow)
Union(Range("A1:A" & lRow), Range(Cells(1, Cel.Column), Cells(lRow, Cel.Column))).Copy
Sheets.Add
ActiveSheet.Name = Cel.Value 'Cel is Range("B1")
Range("A1").PasteSpecial 'This pastes Range("A1:B" & lRow) to Range("A1:B" & lRow)
Sheets("Master").Select
Next Cel 'There is only One Cell in Range("B1")

Application.CutCopyMode = False

'There is no Sheet1. It was renamed to the value in Range("B1")
b.Sheets("Sheet1").Range("A:Z").Copy Destination:=ThisWorkbook.Sheets("Sheet1").Range("C:Z")
'That will cause an error because Range("A:Z") is not the same size as Range("C:Z"). Use Range("C1")

b.Close
End Sub

[klpw]

Hi SamT,

I've recompiled the code and I've got the error for the line below.

wb1.Sheets("Sheet1").Column("A1:C1").Copy Destination:=ActiveWorkbook.Sheets("Sheet1").Range("C1:E1" & erow)
I was wondering whether could you help me analyze where is my mistake. Thanks.


Sub Run()
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim ws1LRow As Long, ws2LRow As Long
Dim ws1LCol As Long, ws2LCol As Long
Dim erow As Long


Set wb1 = Workbooks.Open("C:\Users\maggie\Desktop\trial.xlsx")
Set ws1 = wb1.Sheets("Sheet1")

With ws1
ws1LRow = .Range("C" & .Rows.Count).End(xlUp).Row
ws1LCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With


Set wb2 = ActiveWorkbook
Set ws2 = ActiveWorkbook.Sheets("Sheet1")

With ws2
ws2LRow = .Range("C" & .Rows.Count).End(xlUp).Row
ws2LCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With

If ws1LRow = ws2LRow Then
End If
'With ws2
erow = ws2.Cells(Rows.Count, 3).End(xlUp).Row + 1
wb1.Sheets("Sheet1").Column("A1:C1").Copy Destination:=ActiveWorkbook.Sheets("Sheet1").Range("C1:E1" & erow)
Application.ScreenUpdating = True
'End With
wb1.Close
End Sub

[SamT]

Set wb1 = Workbooks.Open("C:\Users\maggie\Desktop\trial.xlsx")
Set ws1 = wb1.Sheets("Sheet1")

With ws1
ws1LRow = .Range("C" & .Rows.Count).End(xlUp).Row 'LastRow of Sheet1, trial.xlsx
ws1LCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With


Set wb2 = ActiveWorkbook 'trial.xlsx is active workbook, it is the last book opened
Set ws2 = ActiveWorkbook.Sheets("Sheet1")

With ws2 '
ws2LRow = .Range("C" & .Rows.Count).End(xlUp).Row 'LastRow of Sheet1, trial.xlsx
ws2LCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With


ws1 & ws2 are the same sheet, so this code Evaluates as If True then End If

If ws1LRow = ws2LRow Then '
End If
'Is the same As
If ws1LRow = ws2LRow Then End If
This is more complex

wb1.Sheets("Sheet1").Column("A1:C1").Copy Destination:=ActiveWorkbook.Sheets("Sheet1").Range("C1:E1" & erow)
Application.ScreenUpdating = True
'End With
Column("A1:C1"): Column is singular, it can only refer to one column.
Columns("A1:C1") has a syntax error, "A1:C1" does not refer to any columns. "A:C" would work as would Range("A1:C1:").EntireColumn and Range("A:C")

Range("C1:E1" & erow): erow is a number, say "19". This would Evaluate as Range("C1:E119")

For a copy-Paste, you only need the top left cell as the destination: Range("C") & erow or Cells(erow, "C")

I wish I could help more, But I am not clear about the structure/layout of your data.

[klpw]

Hi SamT,

I've changed my code to the following. However, it doesn't seem to compare the data in between workbooks. Also, it didn't copy all the updated data to the next empty row in another workbook. Instead, it copy the updated data as how the position is(eg. in the middle of the database).


Sub test()
Dim varSheetA As Variant
Dim varSheetB As Variant
Dim strRangeToCheck As String
Dim strRangeToC As String
Dim iRow As Long
Dim iCol As Long
Dim wbkA As Workbook
Dim eRow As Long
Dim nlin As Integer
Dim ncol As Integer

nlin = 1
ncol = 1

Set wbkA = Workbooks.Open(Filename:="C:\Users\meg\Desktop\flurenda.xlsx")
strRangeToCheck = "A:C"
strRangeToC = "C:E"
'Debug.Print Now
varSheetA = wbkA.Worksheets("Sheet1").Range(strRangeToCheck)
varSheetB = ThisWorkbook.Worksheets("Sheet1").Range(strRangeToC)
'Debug.Print Now
'Warning: VarSheetA and VarSheetB result in arrays of the ENTIRE respective workbook
' using LBound() to UBound() causes the ENTIRE workbook to be processed,
' regardless of how much is actually used.
' I'd suggest using something like:
' thisworkbook.select
' MaxRow = ActiveCell.SpecialCells(xlLastCell).Row
' MaxCol = ActiveCell.SpecialCells(xlLastCell).Column
' For iRow = 1 to MaxRow
' For iCol = 1 to MaxCol
'--------------------------------------
For iRow = LBound(varSheetA, 1) To UBound(varSheetA, 1)
For iCol = LBound(varSheetA, 2) To UBound(varSheetA, 2)
If varSheetA(iRow, iCol) = varSheetB(iRow, iCol) Then
' Cells are identical.
' Do nothing.
Else
Cells(iRow, iCol) = varSheetA(iRow, iCol)
eRow = ThisWorkbook.Worksheets("Sheet1").Range("C65536").End(xlUp).Row + 1
wbkA.Sheets("Sheet1").Range("A" & iRow & ":C" & iRow).Copy Destination:=ThisWorkbook.Sheets("Sheet1").Range("C" & eRow & ":E" & eRow)
'eRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, 3).End(xlUp).Row + 1
'ThisWorkbook.Sheets("Sheet1").Range("C" & eRow & ":E" & eRow).Value = wbkA.Sheets("Sheet1").Range("A" & iRow & ":C" & iRow).Value
Exit For
End If
Next
Next
wbkA.Close savechanges:=False
End Sub

[SamT]

try this
Set wbkA = Workbooks.Open(Filename:="C:\Users\meg\Desktop\flurenda.xlsx")
strRangeToCheck = "A:C"
strRangeToC = "C:E"

varSheetA = wbkA.Worksheets("Sheet1").Range(strRangeToCheck)
varSheetB = ThisWorkbook.Worksheets("Sheet1").Range(strRangeToC)
For iRow = LBound(varSheetA, 1) To UBound(varSheetA, 1)
For iCol = LBound(varSheetA, 2) To UBound(varSheetA, 2)
If varSheetA(iRow, iCol) = varSheetB(iRow, iCol) Then GoTo NextiRow
Next

Cells(iRow, iCol) = varSheetA(iRow, iCol)
eRow = ThisWorkbook.Worksheets("Sheet1").Range("C65536").End(xlUp).Row + 1
ThisWorkbook.Sheets("Sheet1").Range("C" & eRow & ":E" & eRow) = varSheetA(iRow, iCol)

NextiRow:
Next

[klpw]

Hi SamT,

I've had 'subscript out of range' error for the line command below:

Cells(iRow, iCol) = varSheetA(iRow, iCol)

[snb]

Why ?

http://www.thecodecage.com/forumz/showthread.php?t=214973

[arthurbr]

Also cross posted at excelforums - msofficeforums

[SamT]

Cross Posting (http://www.vbaexpress.com/forum/showthread.php?18537-Cross-Posting&p=137004&viewfull=1#post137004)