Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 366
  • Last Modified:

VBA: Compare two columns in two files

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
yahoo800
Asked:
yahoo800
  • 14
  • 10
1 Solution
 
SiddharthRoutCommented:
Where are you running this code from? 01Manufacturers.xls or Inventory and Spares - Template last.xls?

Sid
0
 
SiddharthRoutCommented:
The code is ready. Will make minor adjustments after you confirm from where are you running the code.

Sid
0
 
yahoo800Author Commented:
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
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
SiddharthRoutCommented:
5 mins :)

Sid
0
 
SiddharthRoutCommented:
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
 
SiddharthRoutCommented:
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
 
yahoo800Author Commented:
i get error 1004 on lines with a/bcellin on both files
0
 
SiddharthRoutCommented:
Can you give me the line number please? or the code where it is erroring out?

Sid
0
 
yahoo800Author Commented:
11:     Set aCell = wkb1.Sheets(1).Range("S2:S" & LastRowWs1)
0
 
yahoo800Author Commented:
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
 
yahoo800Author Commented:
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
 
SiddharthRoutCommented:
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
 
yahoo800Author Commented:
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
 
SiddharthRoutCommented:
Can you upload both the files that you are using? Let me test it myself :)

Sid
0
 
yahoo800Author Commented:
these are the files below. i removed irrelevant data.
Inventory-and-Spares---Template-.xlsx
01Manufacturers.xlsx
0
 
SiddharthRoutCommented:
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
 
SiddharthRoutCommented:
Quick question. I see you have multiple instances of "Caterpillar" Do you want all of them to get red?

Sid
0
 
yahoo800Author Commented:
yes if possible. Can u make it working from Inventory-and-Spares?
thanks
0
 
SiddharthRoutCommented:
Sure. Had stepped out. Let me work on it :)

Sid
0
 
SiddharthRoutCommented:
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
 
yahoo800Author Commented:
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
 
SiddharthRoutCommented:
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
 
yahoo800Author Commented:
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
 
SiddharthRoutCommented:
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

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 14
  • 10
Tackle projects and never again get stuck behind a technical roadblock.
Join Now