+ Reply to Thread
Results 1 to 5 of 5

VBA compare worksheets - Adjustment

Hybrid View

FixandFoxi VBA compare worksheets -... 06-18-2012, 08:36 AM
arlu1201 Re: VBA compare worksheets -... 06-19-2012, 06:04 AM
FixandFoxi Re: VBA compare worksheets -... 06-19-2012, 07:54 AM
arlu1201 Re: VBA compare worksheets -... 06-19-2012, 08:12 AM
FixandFoxi Re: VBA compare worksheets -... 06-21-2012, 04:18 AM
  1. #1
    Registered User
    Join Date
    06-06-2012
    Location
    Switzerland
    MS-Off Ver
    MS Excel 365
    Posts
    68

    VBA compare worksheets - Adjustment

    Hi!

    I found the below code in this forum to compare the content of two worksheets within the same workbook. In fact, the code is working pretty good. However, when the code does not find any differences, I have an "out of range". Any idea, how to fix this with a pop-up "Nothing found"? Thanks in advance!

    Option Explicit
    Sub CompareRanges()
    Dim rng(2) As Range
    Dim cDif As Collection
    Dim r&, c&, i%, n&
    Dim val(1), itm, dmp
    
    For i = 0 To 1
    On Error Resume Next
    Set rng(i) = _
    Application.InputBox( _
    "Select a range." & vbLf & _
    "OneCell/AllCells translates to UsedRange", Type:=8)
    If rng(i) Is Nothing Then
    i = i - 1
    ElseIf rng(i).Count = 1 Or rng(i).Count = 2 ^ 24 Then
    Set rng(i) = rng(i).Worksheet.UsedRange
    End If
    Next
    On Error GoTo 0
    If rng(0).Worksheet Is rng(1).Worksheet Then
    If Not Intersect(rng(0), rng(1)) Is Nothing Then
    MsgBox "Ranges overlap"
    Exit Sub
    End If
    End If
    
    Set cDif = New Collection
    val(0) = rng(0).Value
    val(1) = rng(1).Value
    For r = 1 To Application.Min( _
    rng(0).Rows.Count, rng(1).Rows.Count)
    For c = 1 To Application.Min( _
    rng(0).Columns.Count, rng(1).Columns.Count)
    If StrComp(val(0)(r, c), val(1)(r, c), vbTextCompare) <> 0 Then
    cDif.Add Array(r, c)
    End If
    
    Next
    If r Mod 1000 = 1 Then Application.StatusBar = "Comparing row: " & r
    Next
    
    If cDif.Count > Rows.Count Then
    MsgBox "Too many differences!"
    Exit Sub
    End If
    
    Application.StatusBar = "Preparing output"
    ReDim dmp(1 To cDif.Count, 1 To 4)
    For Each itm In cDif
    n = n + 1
    With rng(0)(itm(0), itm(1))
    dmp(n, 1) = .Address
    dmp(n, 2) = .Value
    End With
    With rng(1)(itm(0), itm(1))
    dmp(n, 3) = .Address
    dmp(n, 4) = .Value
    End With
    
    Next
    Application.StatusBar = False
    
    Set rng(2) = Application.InputBox(cDif.Count & _
    "differences found" & vbLf & _
    "Where to dump?", Type:=8)
    rng(2).Resize(cDif.Count, 4) = dmp
    
    End Sub
    Last edited by FixandFoxi; 06-18-2012 at 09:47 AM.

  2. #2
    Forum Contributor arlu1201's Avatar
    Join Date
    09-09-2011
    Location
    Bangalore, India
    MS-Off Ver
    Excel 2003 & 2007
    Posts
    19,166

    Re: VBA compare worksheets - Adjustment

    Can you attach the sample file that you are using with the code?
    If I have helped, Don't forget to add to my reputation (click on the star below the post)
    Don't forget to mark threads as "Solved" (Thread Tools->Mark thread as Solved)
    Use code tags when posting your VBA code: [code] Your code here [/code]

  3. #3
    Registered User
    Join Date
    06-06-2012
    Location
    Switzerland
    MS-Off Ver
    MS Excel 365
    Posts
    68

    Re: VBA compare worksheets - Adjustment

    Hi & thanks for your reply! Please find attached the file. The workbook has two sheets. As you will note, there is a difference in cell B6 (the age is missing in the second sheet). When you now perform the macro, the code will drop you this difference. However, as soon as the sheets are equal (e.g. add 96 in the second sheet), I have the "out of range".
    Attached Files Attached Files

  4. #4
    Forum Contributor arlu1201's Avatar
    Join Date
    09-09-2011
    Location
    Bangalore, India
    MS-Off Ver
    Excel 2003 & 2007
    Posts
    19,166

    Re: VBA compare worksheets - Adjustment

    Your code is giving at error on this line
    ReDim dmp(1 To cDif.Count, 1 To 4)
    But i dont have much experience with arrays. Let us see if you get some help from others here or i can push it to the experts.

  5. #5
    Registered User
    Join Date
    06-06-2012
    Location
    Switzerland
    MS-Off Ver
    MS Excel 365
    Posts
    68

    Re: VBA compare worksheets - Adjustment

    After Line47 I added:

    If cDif.Count = 0 Then
    MsgBox "No differences!"
    Exit Sub
    End If
    The code is now working when NO/NIL differences are found.

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1