View Single Post
 
Old 01-26-2016, 12:13 AM
klpw klpw is offline Windows 7 64bit Office 2013
Novice
 
Join Date: Dec 2015
Posts: 5
klpw is on a distinguished road
Exclamation

Hi all,

I've issue in comparing the data in workbooks. For instance, it doesn't update the rows which is being added in the workbook. What I want it to do is to check row by row and update entire row to next blank row in another workbook if the data in the workbook is not same as the data in another workbook.

Code:
Sub test()
Dim varSheetA As Variant
Dim varSheetB As Variant
Dim strRangeToCheck As String
Dim strRangeToC As String
Dim iRow As Long
Dim iRow2 As Long
Dim iCol As Long
Dim wbkA As Workbook
Dim eRow As Long
Dim cfind As Range
Dim c As Range
Dim rng As Range
Dim i, j, k As Integer
Dim newarr As String
Dim existarr As String
Dim b As Boolean
Set wbkA = Workbooks.Open(Filename:="C:\Users\pwloo\Desktop\main.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 iRow2 = LBound(varSheetB, 1) To UBound(varSheetB, 1)
    For iCol = LBound(varSheetA, 2) To UBound(varSheetA, 2)
        If ThisWorkbook.Sheets("Sheet1").Range("C").Value = wbkA.Sheets("Sheet1").Range("A") Then
        If ThisWorkbook.Sheets("Sheet1").Range("D").Value = wbkA.Sheets("Sheet1").Range("B") Then
        If ThisWorkbook.Sheets("Sheet1").Range("E").Value = wbkA.Sheets("Sheet1").Range("C") Then
        If varSheetA(iRow, iCol).EntireRow = varSheetB(iRow, iCol).EntireRow Then
            ' Cells are identical.
            ' Do nothing
Else
If ThisWorkbook.Sheets("Sheet1").Range("C" & iRow2).Value = wbkA.Sheets("Sheet1").Range("A" & iRow).Value Then
b = False
Else
If ThisWorkbook.Sheets("Sheet1").Range("D" & iRow2).Value = wbkA.Sheets("Sheet1").Range("B" & iRow).Value Then
b = False
Else
If ThisWorkbook.Sheets("Sheet1").Range("E" & iRow2).Value = wbkA.Sheets("Sheet1").Range("C" & iRow).Value Then
b = False
        Else
            eRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, 3).End(xlUp).Row + 1
            ThisWorkbook.Sheets("Sheet1").Range("C" & eRow & ":E" & eRow).EntireRow = wbkA.Sheets("Sheet1").Range("A" & iRow & ":C" & iRow).EntireRow
            Exit For
        End If
        End If
        End If
        End If
        End If
        End If
        End If
        Next
        Next
   Next
wbkA.Close savechanges:=False
End Sub
Reply With Quote