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
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