3

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

5
  • The data is matching product barcodes, so it has to be exact, Would trimming only remove whitespace? if so, no I haven't is it just trim(PartNo1) for example? what's the correct syntax?
    – James King
    Dec 6, 2013 at 10:14
  • The syntax in your case would be Let PartNo2 = Trim(Worksheets("Linnworks Supplier Update").Cells(SupRow, 1).Value) (and PartNo1 respectively). This would remove any leading or trailing whitespace. - There is an implicit type cast, I think, as your variables are dimed as string, but I don't see a problem there. - As to performance, I recommend not touching the status bar, if you do not need it... Dec 6, 2013 at 10:22
  • Jumping in and out of control structures is, by the way, an easy way to get into problems... ;) Can you try to restructure your code to not use gotos? Your problems may vanish half way there. Dec 6, 2013 at 10:31
  • The only reason I touch the status bar is because it takes anywhere between 1-3mins to complete the macro. its useful for the user to see progress of the macro so they know it hasn't crashed! But thank you for the advice.
    – James King
    Dec 6, 2013 at 10:36
  • I have tried using for loops to remove the jumping structures but its seemed to fall over and not match anything at all. probably due to my bad coding, but I simply couldn't get it to function any other way.
    – James King
    Dec 6, 2013 at 10:38

1 Answer 1

2

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
4
  • Thank you, This worked well with a few tweeks I can make this work I think. The only issue is that for anything that doesn't match I need to output "None" or something similar instead of partno2(and the offset), also would prefer the inclusion of some-kind of progress bar for the user, i'm guessing I could wrap this all the same for loop I used earlier?
    – James King
    Dec 6, 2013 at 10:46
  • yea you could use your bar status code with this. instead of printing something while the loop is running think about a different approach => check the range in the printed area and if the cell is empty, means no match was found and then stick in a No match in there. It should be very simple, if you have questions please ask
    – user2140173
    Dec 6, 2013 at 10:50
  • 1
    ive added the part that puts no match if there was no match
    – user2140173
    Dec 6, 2013 at 10:52
  • 2
    Thank you for your support, if I come across anything else I'm stuck with I will let you know. again, many thanks for your help!
    – James King
    Dec 6, 2013 at 10:52

Your Answer

Reminder: Answers generated by Artificial Intelligence tools are not allowed on Stack Overflow. Learn more

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.