Stock Check Multiple Variables and Pulling Information Through

[lawsonj08]

Hello,

I'm new to VBA, so apologies if this seems a simple one.!

I'm currently working on a stock check spreadsheet which contain a stock list with datasheets numbers (these would be typical numbers, but the cell may contain more than one) and size, and a requirements sheet with a typical datasheet (single value typically but may be more than), and a size.

I have wrote the below:-

Sub stock_check()


Sheets("Armada").Select


Dim datasheet_armada As Range
Dim datasheet_stock As Range


Set datasheet_armada = Range("ac1:aC6000")
Set datasheet_stock = Sheets("Stock").Range("E1:E6000")


For Each cell In datasheet_armada


If cell.Value Like "*" & datasheet_stock & "*" And (cell.Offset(0, -21).Value = datasheet_stock.cell.Offset(0, 5).Value) Then


cell.Offset(0, 34).Value = datasheet_stock.Cells.Offset(0, -2).Value


End If
Next cell
End Sub

What the aim of this is that it would check the datasheet in the initial range against the datasheet on the stock tab. If it finds a match, i want it to check the valve that is offset on both and see if they match and if they do, i want it to pull information from the stock tab (a unique reference to the specific item)

Some sample data would be as follows:-
Sizes - will be inches so 2", 4", etc
Datasheets - will be BA-F01, BA-F02 etc (note these will not be exact matches as one cell may contain more than one)
Unique Reference - SPR-123456-0001, VLV-123456-0002

If you could point me in the right direction; it would be appreciated.

Thanks!

 

[mumps]

I'm sorry but I still find it a little hard to follow. I must be "thick". Could you please upload an example file?

 

[lawsonj08]

Haha I’m sure that’s not the case!

i don’t have access to excel right now but if you imagine the cells that are unique numbers are serial numbers and therefore are specific to that individual item - on the basis that these are unique and specific, I want the results to only show once and thus be unique

so if for example the in cell C1 the result of the above formula is Asd-123, and D5 returns the same result, but it is also possible to have Asd-789 based on the index / March formula, how can I make the formula ignore the resultant value in cell C1 and show a unique answer?

If this doesn’t make sense, I can show the spreadsheet later this evening - thank you

 

[mumps]

The problem is that in the file you uploaded, there is no "Asd-789" and there is no data in D5. I think I'll wait until you can upload the file.

 

[lawsonj08]

Sorry Mumps, i came up with a additional example, but this wasn't in the file so this has lead to confusion..

See the amended spreadsheet here:-https://www.sendspace.com/file/7oyr7w


So what you will see is that the Stock Availability in Column D works fine, with the exception that it is repeating the Stock Unique Numbers. Now i would like to have these stock unique numbers assigned to an individual record index, so for example, Cell D1 is correct, but i would want cell D6 to show ABC-12345-0005 as that is the next occurrence where the match parameters are found. Likewise, cell D10, should be ABC-12345-0009 as the previous 2 matches results have been found.

Expanding on this, in the event that there is no result, i would like it to display "No Stock" which i understand can be IFERROR(). But, i would want the resultant formula for the above, to be the IFERROR.

Hopefully this now makes sense.

if you could do this in VBA with indicative comments stating whats the steps are doing, it would be appreciated

Thanks again

 

[mumps]

This was rather challenging for me. Try this macro and see if it works for you. I hope the explanatory comments make sense. I haven't included any code to address this:

in the event that there is no result, i would like it to display "No Stock"

Could you please explain in detail what you mean by this?

Sub CopyUniqueNum()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, rng As Range, fRng As Range
    Dim sAddr As String
    Set srcWS = Sheets("Stock")
    Set desWS = Sheets("Requirement")
    LastRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each rng In desWS.Range("C2:C" & LastRow) 'loops through column C of "Requirement" sheet
        Set fRng = srcWS.Range("C:C").Find(rng, LookIn:=xlValues, lookat:=xlPart) 'looks for value in columnC of "Stock" sheet
        If Not fRng Is Nothing Then 'if found
            sAddr = fRng.Address 'sets variable 'sAddr' to address of found value
            Do 'begins a loop
                'checks if unique number is already in column D and if sizes in column B match
                If WorksheetFunction.CountIf(desWS.Range("D2:D" & LastRow), fRng.Offset(0, -2)) = 0 And rng.Offset(0, -1) = fRng.Offset(0, -1) Then
                    rng.Offset(0, 1) = fRng.Offset(0, -2) 'if unique number doesn't exist in column D and the sizes match, copies unique number
                    Exit Do 'exits the loop
                Else 'if aboive statements are not true, executes below code
                    Set fRng = srcWS.Range("C:C").Find(What:=rng, after:=fRng, LookIn:=xlFormulas, lookat:=xlPart, _
                    SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=True) 'finds next value in column C
                    If Not fRng Is Nothing Then ' if found
                        'checks as above same line of code
                        If WorksheetFunction.CountIf(desWS.Range("D2:D" & LastRow), fRng.Offset(0, -2)) = 0 And rng.Offset(0, -1) = fRng.Offset(0, -1) Then
                            rng.Offset(0, 1) = fRng.Offset(0, -2)
                            Exit Do
                        End If
                    End If
                End If
                Set fRng = srcWS.Range("C:C").Find(What:=rng, after:=fRng, LookIn:=xlFormulas, lookat:=xlPart, _
                    SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=True) 'finds next value in column C of "Requirement" sheet
            Loop While fRng.Address <> sAddr
            sAddr = ""
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[lawsonj08]

Thank you Mumps, i've got it working!

What i was meaning with the above was that in the event it displays N/A or blank, i wanted it to display "No Stock" instead. What would be the best way to do that please?

 

[lawsonj08]

Thank you Mumps, i've got it working!

What i was meaning with the above was that in the event it displays N/A or blank, i wanted it to display "No Stock" instead. What would be the best way to do that please?

No need to do anything else Mumps, I've managed to do it with teh following extra sub, then i can just do a call sub

Sub blank_nostock()


Sheets("Armada").Select
Dim SrchRng As range, cell As range
Set SrchRng = range("BK2:BK6000")


For Each cell In SrchRng
       
If cell.Value = "" Then
cell.Value = "No Stock"
End If
Next cell


End Sub

one thing that i have noticed is that with the formula you gave me, it is taking around 30 mins to work through the full spreadsheet - is there any way to speed this up at all please?

Thanks for your help

 

[mumps]

See if this version makes a difference:

Sub CopyUniqueNum()
    With Application
        .ScreenUpdating = False
        .Application.Calculation = xlCalculationManual
    End With
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, fRng As Range
    Dim srcRng As Variant, i As Long
    Dim sAddr As String
    Set srcWS = Sheets("Stock")
    Set desWS = Sheets("Requirement")
    LastRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    srcRng = desWS.Range("B2:B" & LastRow).Resize(, 2).Value
    For i = LBound(srcRng) To UBound(srcRng)
        Set fRng = srcWS.Range("C:C").Find(srcRng((i), 2), LookIn:=xlValues, lookat:=xlPart) 'looks for value in columnC of "Stock" sheet
        If Not fRng Is Nothing Then 'if found
            sAddr = fRng.Address 'sets variable 'sAddr' to address of found value
            Do 'begins a loop
                'checks if unique number is already in column D and if sizes in column B match
                If WorksheetFunction.CountIf(desWS.Range("D2:D" & LastRow), fRng.Offset(0, -2)) = 0 And srcRng((i), 1) = fRng.Offset(0, -1) Then
                    desWS.Cells(i + 1, 4) = fRng.Offset(0, -2) 'if unique number doesn't exist in column D and the sizes match, copies unique number
                    Exit Do 'exits the loop
                Else 'if aboive statements are not true, executes below code
                    Set fRng = srcWS.Range("C:C").Find(What:=srcRng((i), 2), after:=fRng, LookIn:=xlFormulas, lookat:=xlPart, _
                    SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=True) 'finds next value in column C
                    If Not fRng Is Nothing Then ' if found
                        'checks as above same line of code
                        If WorksheetFunction.CountIf(desWS.Range("D2:D" & LastRow), fRng.Offset(0, -2)) = 0 And srcRng((i), 1) = fRng.Offset(0, -1) Then
                            desWS.Cells(i + 1, 4) = fRng.Offset(0, -2)
                            Exit Do
                        End If
                    End If
                End If
                Set fRng = srcWS.Range("C:C").Find(What:=srcRng((i), 2), after:=fRng, LookIn:=xlFormulas, lookat:=xlPart, _
                    SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=True) 'finds next value in column C of "Requirement" sheet
            Loop While fRng.Address <> sAddr
            sAddr = ""
        End If
    Next i
    With Application
        .ScreenUpdating = True
        .Application.Calculation = xlCalculationAutomatic
    End With
End Sub

 

[lawsonj08]

thank you - i'll work away with the first macro you provided as ive got it working! thanks for your help

 

[mumps]

You are very welcome. The second macro should speed things up somewhat if you decide to use that version.