Compare 2 Tables Of X Columns

PATSYS · Jun 26th 2009

Hi all,

I have data in sheet1 and sheet2.

I would like a macro that will compare the concatenated values of columns F, G and X of sheet1 vs the concatenated values of columns U, V and W of sheet2.

Those in sheet1 that can not be found in sheet2 will then be shown in a msgbox. If all are found, the msgbox will simply say "Nothing to show".

Thanks

dodger7 · Jun 26th 2009

Re: Compare 2 Tables Of X Columns

Hi Patsy

The following code should do what you want:

Code

Option Base 1
    
Sub compare()


    Dim ws As Worksheet, lRow
    Dim rowc
    
    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")
    
    lRow1 = ws1.Range("F" & Rows.Count).End(xlUp).Address
    rowc = ws1.Range("F2:" & lRow1).Cells.Count


    Dim sh1array() As String
    Dim sh2array() As String
    ReDim sh1array(1 To rowc)
    ReDim sh2array(1 To rowc)
    
        For i = 1 To rowc
            sh1col1 = ws1.Cells(i, 6).Value
            sh1col2 = ws1.Cells(i, 7).Value
            sh1col3 = ws1.Cells(i, 24).Value
            sh1concat = sh1col1 & sh1col2 & sh1col3
          
            sh1array(i) = sh1concat


            sh2col1 = ws2.Cells(i, 21).Value
            sh2col2 = ws2.Cells(i, 22).Value
            sh2col3 = ws2.Cells(i, 23).Value
            sh2concat = sh2col1 & sh2col2 & sh2col3
    
            sh2array(i) = sh2concat
    
        Next i
    
    matchcount = 0
        
        For k = LBound(sh1array) To UBound(sh1array)


        If IsError(Application.Match(sh1array(k), sh2array, 0)) Then 'if not found
            MsgBox sh1array(k) & " Not found"
            matchcount = matchcount + 1
        End If
    
        Next k
    
        If matchcount = 0 Then MsgBox "All found in sheet2"


End Sub

Display More

The code uses the last row in column F as the row count. I attach an example for you.

There may be more elegant replies to your question, but it works

HTH
Jamie

PATSYS · Jun 26th 2009

Re: Compare 2 Tables Of X Columns

Hi Jamie,

Looks great, although would it be opssible it the msgbox shows all simultaenously instead of one item at a time?

Thanks

dodger7 · Jun 26th 2009

Re: Compare 2 Tables Of X Columns

Hi Patsy

try

Code

Option Base 1
    
    Sub compare()


    Dim ws As Worksheet, lRow
    Dim rowc
    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")
    lRow1 = ws1.Range("F" & Rows.Count).End(xlUp).Address
    rowc = ws1.Range("F2:" & lRow1).Cells.Count


    Dim sh1array() As String
    Dim sh2array() As String
    Dim nfarray()
    ReDim nfarray(1)
    ReDim sh1array(1 To rowc)
    ReDim sh2array(1 To rowc)
    
    For i = 1 To rowc
    sh1col1 = ws1.Cells(i, 6).Value
    sh1col2 = ws1.Cells(i, 7).Value
    sh1col3 = ws1.Cells(i, 24).Value
    sh1concat = sh1col1 & sh1col2 & sh1col3
          
     sh1array(i) = sh1concat


    sh2col1 = ws2.Cells(i, 21).Value
    sh2col2 = ws2.Cells(i, 22).Value
    sh2col3 = ws2.Cells(i, 23).Value
    sh2concat = sh2col1 & sh2col2 & sh2col3
    
    sh2array(i) = sh2concat
    
    Next i
    
        matchcount = 1
        msgStr = ""
    For k = LBound(sh1array) To UBound(sh1array)


If IsError(Application.Match(sh1array(k), sh2array, 0)) Then


msgStr = msgStr & sh1array(k) & vbCrLf


matchcount = matchcount + 1
End If
    
     Next k
    
If matchcount = 1 Then MsgBox "All found in sheet2" Else MsgBox msgStr & vbCrLf & "not found"




End Sub

Display More

PATSYS · Jun 27th 2009

Re: Compare 2 Tables Of X Columns

Hi Jamie,

Looking better. However I probably should have mentioned that the list in sheet1 are repeating. So there could be 20 or so lines of the same combinations.

With above case, wwhen I run your code, it shows up the missing combination in as many times as they occur in sheet - it should really just show 1.

Is that possible?

Thanks

dodger7 · Jun 29th 2009

Re: Compare 2 Tables Of X Columns

Hi Patsys

added a find function to check if missing already exists. Should remove duplicates:

Code

Option Base 1
 
Sub compare()
     
    Dim ws As Worksheet, lRow
    Dim rowc
    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")
    lRow1 = ws1.Range("F" & Rows.Count).End(xlUp).Address
    rowc = ws1.Range("F2:" & lRow1).Cells.Count
     
    Dim sh1array() As String
    Dim sh2array() As String
    Dim nfarray()
    ReDim nfarray(1)
    ReDim sh1array(1 To rowc)
    ReDim sh2array(1 To rowc)
     
    For i = 1 To rowc
        sh1col1 = ws1.Cells(i, 6).Value
        sh1col2 = ws1.Cells(i, 7).Value
        sh1col3 = ws1.Cells(i, 24).Value
        sh1concat = sh1col1 & sh1col2 & sh1col3
         
        sh1array(i) = sh1concat
         
        sh2col1 = ws2.Cells(i, 21).Value
        sh2col2 = ws2.Cells(i, 22).Value
        sh2col3 = ws2.Cells(i, 23).Value
        sh2concat = sh2col1 & sh2col2 & sh2col3
         
        sh2array(i) = sh2concat
         
    Next i
     
    matchcount = 1
    msgstr = ""
    For k = LBound(sh1array) To UBound(sh1array)
         
        If IsError(Application.Match(sh1array(k), sh2array, 0)) Then
        If IsError(Application.Find(sh1array(k), msgstr, 1)) Then
            
            msgstr = msgstr & sh1array(k) & vbCrLf
            matchcount = matchcount + 1
        End If
        End If
         
    Next k
     
    If matchcount = 1 Then MsgBox "All found in sheet2" Else MsgBox msgstr & vbCrLf & "not found"
     
     
End Sub

Display More

dodger7 · Jun 29th 2009

Re: Compare 2 Tables Of X Columns

Sorry Patsy

just noticed a mistake in the code - I was missing the last line.
Plus, it was using the 1st row. Does your data have headers?
If so, this code is correct:

Code

Option Base 1
 
Sub compare()
     
    Dim ws As Worksheet, lRow
    Dim rowc
    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")
    lRow1 = ws1.Range("F" & Rows.Count).End(xlUp).Address
    rowc = ws1.Range("F2:" & lRow1).Cells.Count
     
    Dim sh1array() As String
    Dim sh2array() As String
    Dim nfarray()
    ReDim nfarray(1)
    ReDim sh1array(2 To rowc + 1)
    ReDim sh2array(2 To rowc + 1)
     
    For i = 2 To rowc + 1
        sh1col1 = ws1.Cells(i, 6).Value
        sh1col2 = ws1.Cells(i, 7).Value
        sh1col3 = ws1.Cells(i, 24).Value
        sh1concat = sh1col1 & sh1col2 & sh1col3
         
        sh1array(i) = sh1concat
         
        sh2col1 = ws2.Cells(i, 21).Value
        sh2col2 = ws2.Cells(i, 22).Value
        sh2col3 = ws2.Cells(i, 23).Value
        sh2concat = sh2col1 & sh2col2 & sh2col3
         
        sh2array(i) = sh2concat
         
    Next i
     
    matchcount = 1
    msgstr = ""
    For k = LBound(sh1array) To UBound(sh1array)
         
        If IsError(Application.Match(sh1array(k), sh2array, 0)) Then
        If IsError(Application.Find(sh1array(k), msgstr, 1)) Then
            
            msgstr = msgstr & sh1array(k) & vbCrLf
            matchcount = matchcount + 1
        End If
        End If
         
    Next k
     
    If matchcount = 1 Then MsgBox "All found in sheet2" Else MsgBox msgstr & vbCrLf & "not found"
     
     
End Sub

Display More

if you dont have headers and want to compare the first line, this should be OK

Code

Option Base 1
 
Sub compare()
     
    Dim ws As Worksheet, lRow
    Dim rowc
    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")
    lRow1 = ws1.Range("F" & Rows.Count).End(xlUp).Address
    rowc = ws1.Range("F1:" & lRow1).Cells.Count
     
    Dim sh1array() As String
    Dim sh2array() As String
    Dim nfarray()
    ReDim nfarray(1)
    ReDim sh1array(1 To rowc)
    ReDim sh2array(1 To rowc)
     
    For i = 1 To rowc
        sh1col1 = ws1.Cells(i, 6).Value
        sh1col2 = ws1.Cells(i, 7).Value
        sh1col3 = ws1.Cells(i, 24).Value
        sh1concat = sh1col1 & sh1col2 & sh1col3
         
        sh1array(i) = sh1concat
         
        sh2col1 = ws2.Cells(i, 21).Value
        sh2col2 = ws2.Cells(i, 22).Value
        sh2col3 = ws2.Cells(i, 23).Value
        sh2concat = sh2col1 & sh2col2 & sh2col3
         
        sh2array(i) = sh2concat
         
    Next i
     
    matchcount = 1
    msgstr = ""
    For k = LBound(sh1array) To UBound(sh1array)
         
        If IsError(Application.Match(sh1array(k), sh2array, 0)) Then
        If IsError(Application.Find(sh1array(k), msgstr, 1)) Then
            
            msgstr = msgstr & sh1array(k) & vbCrLf
            matchcount = matchcount + 1
        End If
        End If
         
    Next k
     
    If matchcount = 1 Then MsgBox "All found in sheet2" Else MsgBox msgstr & vbCrLf & "not found"
     
     
End Sub

Display More

Jamie

PATSYS · Jun 29th 2009

Re: Compare 2 Tables Of X Columns

Thanks Dodger7.

Dave Hawley · Jun 30th 2009

Re: Compare 2 Tables Of X Columns

Have you considered AdvancedFilter?

Compare 2 Tables Of X Columns

Participate now!

Share