Solved

Compare data of two tables in excel

Posted on 2010-09-15
16
318 Views
Last Modified: 2012-06-27
Dear Experts,
We came across a requirement where in we have two different data having one common column of Group No..
As shown in attached excel file we want the two types of results to compare check the data.

Please suggest macro codes to achieve this,

Regards,
Nilesh.
Example-Cpmpare.xls
0
Comment
Question by:tnilesh2
  • 7
  • 5
16 Comments
 
LVL 24

Expert Comment

by:broomee9
ID: 33682895
0
 

Author Comment

by:tnilesh2
ID: 33688564
Dear Broomee9,
Thanks for looking into, I have checked the artical but found that the given macro codes copies the data of all the sheets & arranged in a single sheet,
But my requirement is something different (as mentioned in attached file).
Please look into & suggest.
Thanks,
Nilesh.
0
 
LVL 32

Expert Comment

by:Robberbaron (robr)
ID: 33709412
looking at your example, you actually want to match on TWO columns of data; Group is not unique.  Add WorkCentre or OpAcct

But "Work Centre" seems to be grouped by only portion of text.  eg C&C , not C&C-06  .  F&G, not F&G-05
What about FS-SP-01 ?  ie cant just check on the portion before the numeral ?

I'll work on something using Group + OpAcct.
0
 
LVL 32

Expert Comment

by:Robberbaron (robr)
ID: 33710184
paste the code into a module and run the R1 macro.  

R2 is just a stub as it is a bit more work to do the summaries so need o confirm on right path before attempting.


Sub R1()
'
' Robberbaron EE
' v1 19.Sept.2010
'
    Dim wsData As Worksheet
    Dim rOpData As Range, rMasterData As Range
    
    Dim wsR1 As Worksheet, rResult1 As Range
    
    Dim lRowStart As Long, lRowEnd As Long
    Dim sTmp As String
    
    'cleanup
    On Error Resume Next
    Application.DisplayAlerts = False
    ActiveWorkbook.Sheets("Data-tmp").Delete
    ActiveWorkbook.Sheets("Result-1").Delete
    ActiveWorkbook.Sheets("Result-2").Delete
    Application.DisplayAlerts = True
    
    
    On Error GoTo 0
    
    
    'copy data to end of workbook for modification
    Sheets("Data").Select
    Sheets("Data").Copy After:=Sheets(ActiveWorkbook.Sheets.Count)
    Set wsData = ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
    wsData.Name = "Data-tmp"
    
    'assume format unchanged
    Set rOpData = RealUsedRange(Columns("K:K"))
    lRowStart = rOpData.Row
    lRowEnd = rOpData.Row + rOpData.Rows.Count - 1
    
    'insert new sort index col
    Columns("K:K").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    'add sort index
    sTmp = "K" & Format(lRowStart, "0") & ":" & "K" & Format(lRowEnd, "0")
    Range(sTmp).FormulaR1C1 = "=TEXT(RC[-2],""0="") & TEXT(RC[-1],""00"")"
    wsData.Cells(lRowStart, 11) = "Index"
    

    Application.CutCopyMode = False
        
    With wsData.Sort
        .SortFields.Clear
        sTmp = "K" & Format(lRowStart + 1, "0") & ":" & "K" & Format(lRowEnd, "0")
        .SortFields.Add Key:=Range(sTmp), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            
        sTmp = "N" & Format(lRowStart + 1, "0") & ":" & "N" & Format(lRowEnd, "0")
        .SortFields.Add Key:=Range(sTmp), _
            SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
            
        sTmp = "I" & Format(lRowStart, "0") & ":" & "N" & Format(lRowEnd, "0")
        .SetRange Range(sTmp)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        

        .Apply
    End With
    'now have useful source data range
    sTmp = "I" & Format(lRowStart, "0") & ":" & "N" & Format(lRowEnd, "0")
    Set rOpData = wsData.Range(sTmp)
    sTmp = "K" & Format(lRowStart + 1, "0") & ":" & "K" & Format(lRowEnd, "0")
    Set rOpIndex = wsData.Range(sTmp)
    
    Set rMasterData = RealUsedRange(Range("B4:G65536"))

    
    'now insert the Results1 page
    Set wsR1 = ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Sheets("Data"), Count:=1)
    wsR1.Name = "Result-1"
    'format the column widths
    wsR1.Columns(1).ColumnWidth = 8.29
    wsR1.Columns(2).ColumnWidth = 16.71
    wsR1.Columns(3).ColumnWidth = 10.57
    wsR1.Columns(4).ColumnWidth = 9.57
    wsR1.Columns(5).ColumnWidth = 12.71
    wsR1.Columns(6).ColumnWidth = 19.29
    wsR1.Columns(7).ColumnWidth = 10
    wsR1.Columns(8).ColumnWidth = 16.71
    wsR1.Columns(9).ColumnWidth = 9.23
    'wsR1.Columns("A:A").Width = 8.29

    
    Set rResult1 = wsR1.Range("A1")
    
    'copy headers
    rMasterData.Cells(1, 1).Resize(, 6).Copy rResult1
    rOpData.Cells(1, 4).Resize(, 3).Copy rResult1.Offset(0, 6)
    
    imastercounter = 1: iOpCounter = 1: ioutputrow = 1
    For imastercounter = 1 To rMasterData.Rows.Count - 1
        'loop through the masterdata
        'copy the master record to output
        rMasterData.Offset(imastercounter, 0).Cells(1, 1).Resize(, 6).Copy rResult1.Offset(ioutputrow, 0)
        sIndex = Format(rMasterData.Offset(imastercounter, 0).Cells(1, 1).Value, "0=") & Format(rMasterData.Offset(imastercounter, 3).Cells(1, 1).Value, "00")
        
        'find the index in OpData.
        With rOpIndex
            Set ri1 = .Find(What:=sIndex, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            Set ri2 = .Find(What:=sIndex, _
                            After:=.Cells(1), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False)
            If ri1 Is Nothing Or ri2 Is Nothing Then
                MsgBox "Nothing found"
            End If
        End With
        Range(ri1.Offset(0, 1), ri2.Offset(0, 3)).Copy rResult1.Offset(ioutputrow, 6)
        
        'move the results line down
        ioutputrow = ioutputrow + ri2.Row - ri1.Row + 1
    Next
    ActiveSheet.Range("A1").Select

    'cleanup
    On Error Resume Next
    Application.DisplayAlerts = False
    ActiveWorkbook.Sheets("Data-tmp").Delete
    Application.DisplayAlerts = True
    
    
    On Error GoTo 0

End Sub

Sub R2()
    Dim wsR1 As Worksheet, wsR2 As Worksheet
    
    'now insert the Results2 page
    Set wsR2 = ActiveWorkbook.Sheets.Add(After:=wsR1, Count:=1)

End Sub

Public Function RealUsedRange(src As Range) As Range
    'http://www.vbaexpress.com/kb/getarticle.php?kb_id=82
    'by DRJ
    Dim FirstRow        As Long
    Dim LastRow         As Long
    Dim FirstColumn     As Integer
    Dim LastColumn      As Integer
    Dim rX As Long, cX As Integer
    On Error Resume Next
     
    rX = src.Rows.Count: cX = src.Columns.Count
    
    FirstRow = src.Cells.Find(What:="*", After:=src.Cells(rX, cX), LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
     
    FirstColumn = src.Cells.Find(What:="*", After:=src.Cells(rX, cX), LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column
     
    LastRow = src.Find(What:="*", After:=src.Cells(1, 1), LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
     
    LastColumn = src.Find(What:="*", After:=src.Cells(1, 1), LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
     
    Set RealUsedRange = Range(Cells(FirstRow, FirstColumn), Cells(LastRow, LastColumn))
     
    On Error GoTo 0
     
End Function

Open in new window

0
 

Author Comment

by:tnilesh2
ID: 33714083

Dear Robberbaron,
Thanks for looking into,
 
Let me answer your queries posted in your first reply –
 
looking at your example, you actually want to match on TWO columns of data; Group is not unique.  Add WorkCentre or OpAcct -  As shown in file, I want to compare the actual usage of work centers against the work center given in master data where the common string bet two data is “Group No.” & “OpAc No..”.
 
But "Work Centre" seems to be grouped by only portion of text.  eg C&C , not C&C-06  .  F&G, not F&G-05
What about FS-SP-01 ?  ie cant just check on the portion before the numeral ? – No, we do not want to group work center by portion of text as shown in file, every work center is mentioned individually.
 
I'll work on something using Group + OpAcct. – Yes absolutely correct.
 
 
Once again I thank you for the solution (macro codes) given by you.

But, I tried the codes by inserting these macro codes as Module & found that excel is not showing option to “Run” the macro (the updated file is attached herewith).
 
Please suggest how to tackle this problem, may be I am doing it wrongly.
 
Regards,
Nilesh.
Example-Cpmpare-1.xls
0
 
LVL 32

Expert Comment

by:Robberbaron (robr)
ID: 33721354
you are correct.  The macro needs to be named RES1  , not R1 which conflicts with the cell R1.

just change the Sub R1()  to be sub RES1()


if this looks ok, can then look at the Result2 requirement which is a bit harder due to the summations required. need to think about the most efficient method.
0
Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 32

Expert Comment

by:Robberbaron (robr)
ID: 33721367
can we change the order in which WorkCtr is presented ?  ie ascending or decending ratehr than mixed ?
0
 

Author Comment

by:tnilesh2
ID: 33722837
Dear Robber Baron,
I have changed the Sub R1()  to be sub RES1() similarly changed the Sub R2()  to be sub RES2() & execute the macro but some Compile Error has occurred (the snap is attached herewith).
Please suggest how to overcome the error.
Regarding your second query of order of work center (in Required Result - 2) - our goal is to show no. of occurrence of each work center against work center of same "Group + OpAcct", if it is achieved then we can re-arrange it as per our convenience.
Thanks again,
Looking forward for your valuable help,
Regards,
Nilesh.

untitled.bmp
Example-Cpmpare-2.xls
0
 
LVL 32

Expert Comment

by:Robberbaron (robr)
ID: 33723150
I have merged the routines into one.

output is correct in detail, formatting may need correction by yourself.


Option Explicit

Sub MakeResults()

'
' Robberbaron @ EE
' v1 19.Sept.2010
' v2 21.Sept.2010

    'cleanup
    On Error Resume Next
    Application.DisplayAlerts = False
    ActiveWorkbook.Sheets("Data-tmp").Delete
    ActiveWorkbook.Sheets("Result-1").Delete
    ActiveWorkbook.Sheets("Result-2").Delete
    Application.DisplayAlerts = True
    
    Dim wsData As Worksheet
    Dim rOpData As Range, rMasterData As Range
    Dim rOpDataGroup As Range, rOpIndex As Range
    
    Dim wsR1 As Worksheet, rResult1 As Range, iOutputrow1 As Integer
    
    Dim wsR2 As Worksheet, rResult2 As Range, iOutputrow2 As Integer
    
    Dim lRowStart As Long, lRowEnd As Long
    Dim sTmp As String, vItem As Variant, sIndex As String
    Dim rI1 As Range, rI2 As Range
    Dim iMasterCounter As Integer, iOpCounter As Integer
    
    Dim colUnique As Collection
    
    'copy data to end of workbook for modification
    Sheets("Data").Select
    Sheets("Data").Copy After:=Sheets(ActiveWorkbook.Sheets.count)
    Set wsData = ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.count)
    wsData.Name = "Data-tmp"
    
    
    
    On Error GoTo 0
    

    
    'assume format unchanged
    Set rOpData = RealUsedRange(Columns("K:K"))
    lRowStart = rOpData.Row
    lRowEnd = rOpData.Row + rOpData.Rows.count - 1
    
    
    'insert new sort index col
    Columns("K:K").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    'add sort index
    sTmp = "K" & Format(lRowStart, "0") & ":" & "K" & Format(lRowEnd, "0")
    Range(sTmp).FormulaR1C1 = "=TEXT(RC[-2],""0="") & TEXT(RC[-1],""00"")"
    wsData.Cells(lRowStart, 11) = "Index"
    

    Application.CutCopyMode = False
        
    With wsData.Sort
        .SortFields.Clear
        sTmp = "K" & Format(lRowStart + 1, "0") & ":" & "K" & Format(lRowEnd, "0")
        .SortFields.Add key:=Range(sTmp), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            
        sTmp = "N" & Format(lRowStart + 1, "0") & ":" & "N" & Format(lRowEnd, "0")
        .SortFields.Add key:=Range(sTmp), _
            SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
            
        sTmp = "I" & Format(lRowStart, "0") & ":" & "N" & Format(lRowEnd, "0")
        .SetRange Range(sTmp)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        

        .Apply
    End With
    'now have useful source data range
    sTmp = "I" & Format(lRowStart, "0") & ":" & "N" & Format(lRowEnd, "0")
    Set rOpData = wsData.Range(sTmp)
    sTmp = "K" & Format(lRowStart + 1, "0") & ":" & "K" & Format(lRowEnd, "0")
    Set rOpIndex = wsData.Range(sTmp)
    
    Set rMasterData = RealUsedRange(Range("B4:G65536"))

    
    'now insert the Results1 page
    Set wsR1 = ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Sheets("Data"), count:=1)
    wsR1.Name = "Result-1"
    'format the column widths
    wsR1.Columns(1).ColumnWidth = 8.29
    wsR1.Columns(2).ColumnWidth = 16.71
    wsR1.Columns(3).ColumnWidth = 10.57
    wsR1.Columns(4).ColumnWidth = 9.57
    wsR1.Columns(5).ColumnWidth = 12.71
    wsR1.Columns(6).ColumnWidth = 19.29
    wsR1.Columns(7).ColumnWidth = 10
    wsR1.Columns(8).ColumnWidth = 16.71
    wsR1.Columns(9).ColumnWidth = 9.23
    
    Set rResult1 = wsR1.Range("A1")
    
    
    'now insert the Results2 page
    wsR1.Copy After:=wsR1
    Set wsR2 = ActiveWorkbook.ActiveSheet
    wsR2.Name = "Result-2"
    
    Set rResult2 = wsR2.Range("A1")
        
    'copy headers
    rMasterData.Cells(1, 1).Resize(, 6).Copy rResult1
    rOpData.Cells(1, 4).Resize(, 3).Copy rResult1.Offset(0, 6)
    
    rMasterData.Cells(1, 1).Resize(, 6).Copy rResult2
    rOpData.Cells(1, 4).Resize(, 3).Copy rResult2.Offset(0, 6)
    rResult2.Offset(0, 7).Value = "Occurance"
    
    
    'now do the data
    iMasterCounter = 1: iOpCounter = 1
    iOutputrow1 = 1: iOutputrow2 = 1
    For iMasterCounter = 1 To rMasterData.Rows.count - 1
        'loop through the masterdata
        'copy the master record to output
        rMasterData.Offset(iMasterCounter, 0).Cells(1, 1).Resize(, 6).Copy rResult1.Offset(iOutputrow1, 0)
        
        rMasterData.Offset(iMasterCounter, 0).Cells(1, 1).Resize(, 6).Copy rResult2.Offset(iOutputrow2, 0)

        sIndex = Format(rMasterData.Offset(iMasterCounter, 0).Cells(1, 1).Value, "0=") & Format(rMasterData.Offset(iMasterCounter, 3).Cells(1, 1).Value, "00")
        
        'find the index in OpData.
        With rOpIndex
            Set rI1 = .Find(What:=sIndex, _
                            After:=.Cells(.Cells.count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            Set rI2 = .Find(What:=sIndex, _
                            After:=.Cells(1), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False)
            If rI1 Is Nothing Or rI2 Is Nothing Then
                MsgBox "Nothing found"
            End If
        End With
        
        Set rOpDataGroup = Range(rI1.Offset(0, 1), rI2.Offset(0, 3))
        
        'output results 1
        rOpDataGroup.Copy rResult1.Offset(iOutputrow1, 6)
                
        'move the results line down
        iOutputrow1 = iOutputrow1 + rI2.Row - rI1.Row + 1
        
        'now do results 2
        'get OpData sections
        Set colUnique = GetUniqueValues(rOpDataGroup.Columns(1))
        For Each vItem In colUnique
            Debug.Print vItem(0), vItem(1)
            
            'find the first occurance in the range
            With rOpDataGroup
                Set rI2 = .Find(What:=vItem(0), _
                                After:=.Cells(1), _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)
            End With
            'copy to Results2
            rI2.Resize(, 3).Copy rResult2.Offset(iOutputrow2, 6)
            rResult2.Offset(iOutputrow2, 7) = vItem(1)
            iOutputrow2 = iOutputrow2 + 1
            
        Next vItem
        
    Next
    ActiveSheet.Range("A1").Select

    
    
    'cleanup
    On Error Resume Next
    Application.DisplayAlerts = False
    ActiveWorkbook.Sheets("Data-tmp").Delete
    Application.DisplayAlerts = True
    
    
    On Error GoTo 0



End Sub


Function GetUniqueValues(InputRange As Range) As Collection
    Dim cl As Range, UniqueValues As New Collection
    Dim iTmp As Integer, sKey As String, objArr(1) As Variant
    Application.Volatile
    
    On Error Resume Next ' ignore any errors
    For Each cl In InputRange.Cells
        sKey = CStr(cl.Value)
        objArr(0) = sKey: objArr(1) = 1
 
        UniqueValues.Add objArr, sKey ' add the unique item
        If Err.Number > 0 Then
            'failed to add new item so must exist
            iTmp = UniqueValues.Item(sKey)(1)
            'remove and readd with increased count
            UniqueValues.Remove (sKey)
            objArr(0) = sKey: objArr(1) = iTmp + 1
            UniqueValues.Add objArr, sKey
            Err.Clear
        End If
    Next cl
    On Error GoTo 0
    
    Set GetUniqueValues = UniqueValues
    
End Function

Open in new window

Example-Cpmpare-2.xls
0
 

Author Comment

by:tnilesh2
ID: 33741001
Dear Robber Baron,
Great !!!,
I have checked the file, the "result 1" is matching exactly as we want, but in "result 2" small correction is required as some dates are showing wrong (refer attached file).

Also when I ran the macro at my pc (having MS office 2003) then it is showing same Compile Error (refer attached snap), when I ran this macro on some other PC having MS office 2007 then it is working fine. Please suggest how to tackle this problem.


Thanks once again,

Regards,
Nilesh.

Example-Cpmpare-2-Solution.xls
untitled.bmp
0
 
LVL 32

Accepted Solution

by:
Robberbaron (robr) earned 500 total points
ID: 33741733
1/ Worksheet.Sort method is an XL07 function so I have used the Range.Sort method to achieve same output

2/ Have fixed the way I searched for the top row in Opdata.  corrects the date, though one of your 'corrections' is not accurate.

PS. When sending screenshots (a good idea), you should save as JPG before uploading.  BMP= 2530kb , JPG = 122kb; makes it much quicker to download


Example-Cpmpare-3.xls
0
 

Author Comment

by:tnilesh2
ID: 33769631




Dear Robber Baron,  
Thank you very much, I have checked the solution & it is working fine with following exceptions –

1. The date of last occurrence is not getting sorted descending (can live with it),
2. The macro XL07 is not working in MS office 2003 as well as MS Office 2007.
3. Suggest the sequence in which the macro has to be run I ran the macro in sequence - Macro 1 => MakeResults => XL07.


 
Requirement is almost done, You are requested to please resolve the above issue.

<Also I found that in macro XL07 End Sub is placed before 'apply & End with so I have changed the code (please suggest if it is wrong).>

Please help,

Regards,
Nilesh.
 

 Sub XL07()

    Application.CutCopyMode = False

        

    With wsData.Sort

        .SortFields.Clear

        sTmp = "K" & Format(lRowStart + 1, "0") & ":" & "K" & Format(lRowEnd, "0")

        .SortFields.Add key:=Range(sTmp), _

            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

            

        sTmp = "N" & Format(lRowStart + 1, "0") & ":" & "N" & Format(lRowEnd, "0")

        .SortFields.Add key:=Range(sTmp), _

            SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal

            

        sTmp = "I" & Format(lRowStart, "0") & ":" & "N" & Format(lRowEnd, "0")

        .SetRange Range(sTmp)

        .Header = xlYes

        .MatchCase = False

        .Orientation = xlTopToBottom

        .SortMethod = xlPinYin

     

   



        .Apply

    End With



 End Sub

Open in new window

Error-424.JPG
Example-Cpmpare-4.xls
0
 
LVL 32

Expert Comment

by:Robberbaron (robr)
ID: 33965147
sorry must have missed your post.

1/ Date of last occurrence is the last one of the workcentre.

2/ The XL07 macro should be deleted as it only works in XL07 ! its a hold over from version2

0

Featured Post

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
In this article we discuss how to recover the missing Outlook 2011 for Mac data like Emails and Contacts manually.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

746 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now