Home » excel » excel – Compare sheet 1 col 1 to sheet 2 col 1 place value in sheet 1 col 6

excel – Compare sheet 1 col 1 to sheet 2 col 1 place value in sheet 1 col 6

Posted by: admin April 23, 2020 Leave a comment

Questions:

First time posting a question, so please correct me if I do anything I’m not supposed to!

I have a macro written on a button press to compare 2 columns on 2 sheets and output either the value from sheet 2 col 1 in sheet 1 col 6 OR output “None” in sheet1 col 6 if there isn’t a match.

My code is buggy and takes a long time to run (around 5000 entry’s on sheet 1 and 2000 on sheet 2).

My code works partly; it only matches around 2/3rd’s of the col 1’s on either sheet.

Sub Find_Sup()

Dim count As Integer
Dim loopend As Integer
Dim PartNo1 As String
Dim PartNo2 As String
Dim partRow As String
Dim SupRow As String
Dim supplier As String

Let partRow = 2
Let SupRow = 2

'Find total parts to check
Sheets("Linnworks Supplier Update").Select
Range("A1").End(xlDown).Select
loopend = Selection.row

Application.ScreenUpdating = False

'main loop
For count = 1 To loopend
jump1:
'progress bar
Application.StatusBar = "Progress: " & count & " of " & loopend & ": " & Format(count / loopend, "0%")
Let PartNo2 = Worksheets("Linnworks Supplier Update").Cells(SupRow, 1).Value

Let supplier = Worksheets("Linnworks Supplier Update").Cells(SupRow, 2).Value

If PartNo2 = "" Then
SupRow = 2
Else

jump2:
Let PartNo1 = Worksheets("Linnworks Stock").Cells(partRow, 1).Value
'add part numbers than do match
If PartNo2 = PartNo1 Then
    Let Worksheets("Linnworks Stock").Cells(partRow, 5).Value = supplier
    Let partRow = partRow + 1
    Let count = count + 1
    GoTo jump2
Else
    Let SupRow = SupRow + 1
    GoTo jump1
End If
End If

Next
Application.StatusBar = True

End Sub 

I have done some coding in C and C++ and a little VB.NET. Any help streamlining this code or pointing me in the right direction would be very gratefully received!

I realise there are similar questions but all other options I’ve tried (nested for each loops) don’t seem to work correctly.

This is the closest I’ve managed to get so far.

Many Thanks for reading

How to&Answers:

try something like this instead and leave feedback so I can edit the answer to match perfectly

Sub Main()

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet

    Set ws1 = Sheets("Linnworks Supplier Update")
    Set ws2 = Sheets("Linnworks Stock")

    Dim partNo2 As Range
    Dim partNo1 As Range

    For Each partNo2 In ws1.Range("A1:A" & ws1.Range("A" & Rows.Count).End(xlUp).Row)
        For Each partNo1 In ws2.Range("A1:A" & ws2.Range("A" & Rows.Count).End(xlUp).Row)
            If StrComp(Trim(partNo2), Trim(partNo1), vbTextCompare) = 0 Then
                ws2.Range("E" & partNo1.Row) = partNo2.Offset(0, 1)
                ws2.Range("F" & partNo1.Row) = partNo2
            End If
        Next
    Next

    'now if no match was found then put NO MATCH in cell
    for each partno1 in ws2.Range("E1:F" & ws2.Range("A" & Rows.Count).End(xlUp).Row)
        if isempty(partno1) then partno1 = "no match"
    next
End Sub