Solved

VBA: Compare two columns in two files

Posted on 2011-03-11
24
354 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
ID: 35107382
Where are you running this code from? 01Manufacturers.xls or Inventory and Spares - Template last.xls?

Sid
0
 
LVL 30

Expert Comment

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

Sid
0
 

Author Comment

by:yahoo800
ID: 35109397
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
Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35109416
5 mins :)

Sid
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35109436
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
ID: 35109440
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
ID: 35132653
i get error 1004 on lines with a/bcellin on both files
0
 
LVL 30

Expert Comment

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

Sid
0
 

Author Comment

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

Author Comment

by:yahoo800
ID: 35136542
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
ID: 35136798
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
ID: 35137105
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
 

Author Comment

by:yahoo800
ID: 35137606
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
ID: 35137626
Can you upload both the files that you are using? Let me test it myself :)

Sid
0
 

Author Comment

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

Expert Comment

by:SiddharthRout
ID: 35137968
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
ID: 35137994
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
ID: 35138182
yes if possible. Can u make it working from Inventory-and-Spares?
thanks
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35138804
Sure. Had stepped out. Let me work on it :)

Sid
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35139262
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
ID: 35140148
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
ID: 35140352
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
ID: 35150177
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
ID: 35150235
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

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

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…
Deploying a Microsoft Access application in a Citrix environment is not difficult but takes a few steps. However, Citrix system people are often of little help, as they typically know next to nothing about Access. The script provided here will take …
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

830 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