Solved

VBA: Compare two columns in two files

Posted on 2011-03-11
24
347 Views
Last Modified: 2012-05-11
Hi there
Im trying to compare two columns and highlight the red cells in one sheet which are missing in the other one. It works fine but having dificulties in restarting cela loop... Did try to do it using do while but no luck as well.
Another thing which im strugling with is writing a code to open those files. Having troubles with path... Found lots of solutions online but none of them works for me...
thanks
find-absences.txt
0
Comment
Question by:yahoo800
  • 14
  • 10
24 Comments
 
LVL 30

Expert Comment

by:SiddharthRout
Comment Utility
Where are you running this code from? 01Manufacturers.xls or Inventory and Spares - Template last.xls?

Sid
0
 
LVL 30

Expert Comment

by:SiddharthRout
Comment Utility
The code is ready. Will make minor adjustments after you confirm from where are you running the code.

Sid
0
 

Author Comment

by:yahoo800
Comment Utility
im running code from Manufacturers but highlight cells in the other.
If its not a problem you could move my code to Inventory and Spares
0
 
LVL 30

Expert Comment

by:SiddharthRout
Comment Utility
5 mins :)

Sid
0
 
LVL 30

Expert Comment

by:SiddharthRout
Comment Utility
If you want to run it from "Manufacturers" then use this. If you want to run it from "Inventory and Spares" then see the next post :)

Sub findabsences()
    Dim wkb1 As Workbook, wkb2 As Workbook
    Dim aCell As Range, bCell As Range
    Dim i As Long
    Dim strSearch As String
    
    Application.ScreenUpdating = False
    
    Set wkb1 = ActiveWorkbook
    LastRowWs1 = wkb1.Sheets(1).Range("A" & Rows.Count).End(xlUp)
    
    '~~> Change the path as applicable
    Set wkb2 = Workbooks.Open("C:\Inventory and Spares - Template last.xls")
    LastRowWs2 = wkb2.Sheets(1).Range("S" & Rows.Count).End(xlUp)
    Set bCell = wkb2.Sheets(1).Range("S2:S" & LastRowWs2)
    
    For i = 3 To LastRowWs1
        strSearch = wkb1.Sheets(1).Range("A" & i).Value
        
        Set aCell = bCell.Find(What:=strSearch, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
    
        If Not aCell Is Nothing Then
            aCell.Interior.ColorIndex = 3
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

Open in new window


Sid
0
 
LVL 30

Expert Comment

by:SiddharthRout
Comment Utility
If you want to run it from "Inventory and Spares"

Sub findabsences()
    Dim wkb1 As Workbook, wkb2 As Workbook
    Dim aCell As Range, bCell As Range
    Dim i As Long
    Dim strSearch As String
    
    Application.ScreenUpdating = False
    
    Set wkb1 = ActiveWorkbook
    LastRowWs1 = wkb1.Sheets(1).Range("S" & Rows.Count).End(xlUp)
    Set aCell = wkb1.Sheets(1).Range("S2:S" & LastRowWs1)
    
    '~~> Change the path as applicable
    Set wkb2 = Workbooks.Open("C:\01Manufacturers.xls")
    LastRowWs2 = wkb2.Sheets(1).Range("A" & Rows.Count).End(xlUp)

    For i = 2 To LastRowWs1
        strSearch = wkb1.Sheets(1).Range("S" & i).Value
        Set bCell = aCell.Find(What:=strSearch, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
    
        If Not bCell Is Nothing Then
            bCell.Interior.ColorIndex = 3
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

Open in new window


Sid
0
 

Author Comment

by:yahoo800
Comment Utility
i get error 1004 on lines with a/bcellin on both files
0
 
LVL 30

Expert Comment

by:SiddharthRout
Comment Utility
Can you give me the line number please? or the code where it is erroring out?

Sid
0
 

Author Comment

by:yahoo800
Comment Utility
11:     Set aCell = wkb1.Sheets(1).Range("S2:S" & LastRowWs1)
0
 

Author Comment

by:yahoo800
Comment Utility
got it working from "Inventory and Spares" but i guess it doesnt return correct values eg it should highlight the ones which are not in manufacturers.
Wouldnt the version attached be more efficient as I have to run it for 5 cols and 5 files at the same time preferably?


fname = ThisWorkbook.Path
    ChDir ThisWorkbook.Path

for i to lastrow

    Sheet1.Range("T1").FormulaR1C1 = "=VLOOKUP(RC[-1],'[01Manufacturers.xls]Sheet1'!C1,1,FALSE)"

Open in new window

0
 

Author Comment

by:yahoo800
Comment Utility
Thats my final version. Any ideas to tweak it?
Sub findabsences2()

    Dim i As Long
    fname = ThisWorkbook.Path
    ChDir ThisWorkbook.Path
    LastRow = ActiveSheet.Range("S" & Rows.Count).End(xlUp).Row
    
    For i = 2 To LastRow
    Sheet1.Range("T" & i).FormulaR1C1 = "=VLOOKUP(RC[-1],'[01Manufacturers.xls]Sheet1'!C1,1,FALSE)"
    Next
    
    Range("T:T").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    For i = 2 To LastRow
    If Cells(i, "T").Text = "#N/A" Then
        With Range("S" & i).Interior
            .Pattern = xlSolid
            .Color = 255
        End With
    End If
    Next
    End Sub

Open in new window

0
 
LVL 30

Expert Comment

by:SiddharthRout
Comment Utility
In the code that I gave if you put this line

msgbox LastRowWs1

before

Set aCell = wkb1.Sheets(1).Range("S2:S" & LastRowWs1)

What do you get?

Sid
0
Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

 

Author Comment

by:yahoo800
Comment Utility
value of last row like expected
it picks it up when i change lastrow to .row but obviously it changes the output
it didnt work as well after i removed dupes from that column

the code below works for all 5 columns/files
Sub findabsences2()
    Application.ScreenUpdating = False
    Dim i As Long
    fname = ThisWorkbook.Path
    ChDir ThisWorkbook.Path
    LastRow = ActiveSheet.Range("S" & Rows.Count).End(xlUp).Row
    
    For i = 2 To LastRow
    Sheet1.Range("CA" & i).FormulaR1C1 = "=VLOOKUP(RC[-60],'[01Manufacturers.xls]Sheet1'!C1,1,FALSE)"
    Sheet1.Range("CB" & i).FormulaR1C1 = "=VLOOKUP(RC[-72],'[03b - SupplierSites.xls]Export Worksheet'!C1,1,FALSE)"
    Sheet1.Range("CC" & i).FormulaR1C1 = "=VLOOKUP(RC[-69],'[UOM INFOR.xls]Sheet1'!C1,1,FALSE)"
    Sheet1.Range("CD" & i).FormulaR1C1 = "=VLOOKUP(RC[-66],'[INFOR CURRENCY.xls]Sheet1'!C1,1,FALSE)"
    Sheet1.Range("CE" & i).FormulaR1C1 = "=VLOOKUP(RC[-51],'[19a - Categories.xlsx]Categories'!C1,1,FALSE)"
    Next

    Range("CA:CE").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    For i = 2 To LastRow
    If Cells(i, "CA").Text = "#N/A" Then
        With Range("S" & i).Interior
            .Pattern = xlSolid
            .Color = 255
        End With
    End If
    If Cells(i, "CB").Text = "#N/A" Then
        With Range("H" & i).Interior
            .Pattern = xlSolid
            .Color = 255
        End With
    End If
    
        If Cells(i, "CC").Text = "#N/A" Then
        With Range("L" & i).Interior
            .Pattern = xlSolid
            .Color = 255
        End With
    End If

    If Cells(i, "CD").Text = "#N/A" Then
        With Range("P" & i).Interior
            .Pattern = xlSolid
            .Color = 255
        End With
    End If

    If Cells(i, "CE").Text = "#N/A" Then
        With Range("AF" & i).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With
    End If

    Next
        Application.ScreenUpdating = True
End Sub

Open in new window

0
 
LVL 30

Expert Comment

by:SiddharthRout
Comment Utility
Can you upload both the files that you are using? Let me test it myself :)

Sid
0
 

Author Comment

by:yahoo800
Comment Utility
these are the files below. i removed irrelevant data.
Inventory-and-Spares---Template-.xlsx
01Manufacturers.xlsx
0
 
LVL 30

Expert Comment

by:SiddharthRout
Comment Utility
Oh Ok. Got it.

Try this code from manufacturers.

Sub findabsences()
    Dim wkb1 As Workbook, wkb2 As Workbook
    Dim aCell As Range, bCell As Range
    Dim i As Long
    Dim strSearch As String
    
    Application.ScreenUpdating = False
    
    Set wkb1 = ActiveWorkbook
    LastRowWs1 = wkb1.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
    
    '~~> Change the path as applicable
    Set wkb2 = Workbooks.Open("C:\Inventory-and-Spares---Template-.xlsx")
    LastRowWs2 = wkb2.Sheets(1).Range("S" & Rows.Count).End(xlUp).Row
    Set bCell = wkb2.Sheets(1).Range("S2:S" & LastRowWs2)
    
    For i = 3 To LastRowWs1
        strSearch = wkb1.Sheets(1).Range("A" & i).Value
        
        Set aCell = bCell.Find(What:=strSearch, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
    
        If Not aCell Is Nothing Then
            aCell.Interior.ColorIndex = 3
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

Open in new window


Sid
0
 
LVL 30

Expert Comment

by:SiddharthRout
Comment Utility
Quick question. I see you have multiple instances of "Caterpillar" Do you want all of them to get red?

Sid
0
 

Author Comment

by:yahoo800
Comment Utility
yes if possible. Can u make it working from Inventory-and-Spares?
thanks
0
 
LVL 30

Expert Comment

by:SiddharthRout
Comment Utility
Sure. Had stepped out. Let me work on it :)

Sid
0
 
LVL 30

Expert Comment

by:SiddharthRout
Comment Utility
Try this from "Inventory-and-Spares---Template-"

Sub findabsences()
    Dim wkb1 As Workbook, wkb2 As Workbook
    Dim aCell As Range, bCell As Range, cCell As Range, rngColor As Range
    Dim i As Long
    Dim strSearch As String
    Dim ExitLoop As Boolean
    
    Application.ScreenUpdating = False
    
    Set wkb1 = ActiveWorkbook
    LastRowWs1 = wkb1.Sheets(1).Range("S" & Rows.Count).End(xlUp).Row
    Set aCell = wkb1.Sheets(1).Range("S2:S" & LastRowWs1)
    
    '~~> Change the path as applicable
    Set wkb2 = Workbooks.Open("C:\01Manufacturers.xlsx")
    LastRowWs2 = wkb2.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row

    For i = 2 To LastRowWs2
        strSearch = wkb2.Sheets(1).Range("A" & i).Value
        Set bCell = aCell.Find(What:=strSearch, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        ExitLoop = False
        If Not bCell Is Nothing Then
            Set cCell = bCell
            If rngColor Is Nothing Then
                Set rngColor = bCell
            Else
                Set rngColor = Union(rngColor, bCell)
            End If
            
            Do While ExitLoop = False
                Set bCell = aCell.FindNext(After:=bCell)
    
                If Not bCell Is Nothing Then
                    If bCell.Address = cCell.Address Then Exit Do
                    If rngColor Is Nothing Then
                        Set rngColor = bCell
                    Else
                        Set rngColor = Union(rngColor, bCell)
                    End If
                Else
                    ExitLoop = True
                End If
            Loop
        End If
    Next i
    
    rngColor.Interior.ColorIndex = 3
    
    wkb2.Close savechanges:=False
    Application.ScreenUpdating = True
End Sub

Open in new window


I noticed that all the cells got colored so it means that all those entries are in 01Manufacturers.xlsx?

Sid
0
 

Author Comment

by:yahoo800
Comment Utility
away from work atm
try my code from Inventory excluding lines 11-14 to see the proper outcome. run it from inventory and keep the other one closed in same location
0
 
LVL 30

Accepted Solution

by:
SiddharthRout earned 500 total points
Comment Utility
Oh Ok. Try this

Sub findabsences()
    Dim wkb1 As Workbook, wkb2 As Workbook
    Dim aCell As Range, bCell As Range
    Dim i As Long
    Dim strSearch As String
    
    Application.ScreenUpdating = False
    
    Set wkb1 = ActiveWorkbook
    LastRowWs1 = wkb1.Sheets(1).Range("S" & Rows.Count).End(xlUp).Row
    
    '~~> Change the path as applicable
    Set wkb2 = Workbooks.Open("C:\01Manufacturers.xlsx")
    LastRowWs2 = wkb2.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
    Set aCell = wkb2.Sheets(1).Range("A2:A" & LastRowWs1)

    For i = 2 To LastRowWs1
        strSearch = wkb1.Sheets(1).Range("S" & i).Value
        Set bCell = aCell.Find(What:=strSearch, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        If bCell Is Nothing Then
            wkb1.Sheets(1).Range("S" & i).Interior.ColorIndex = 3
        End If
    Next i
    
    wkb2.Close savechanges:=False
    Application.ScreenUpdating = True
End Sub

Open in new window


Sid
0
 

Author Comment

by:yahoo800
Comment Utility
i checked it briefly: first using file without duplicates and it didnt work. Than I used the same set ive sent you and noticed that it didnt pick up 'not known' which definitely doesnt exist in the other file ;)
sorry to be annoying but my version is sooooo slow ;)
0
 
LVL 30

Expert Comment

by:SiddharthRout
Comment Utility
Strange, I compared your results to my results and they were same? Do me a favor. just upload an excel file with your results.

Sid
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
The viewer will learn how to simulate a series of coin tosses with the rand() function and learn how to make these “tosses” depend on a predetermined probability. Flipping Coins in Excel: Enter =RAND() into cell A2: Recalculate the random variable…
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

744 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

15 Experts available now in Live!

Get 1:1 Help Now