Index Match with Concatenate in VBA

[Click22]

Hi,

I am trying to create an index match function within VBA.

The reason for this is that I would like to grab the required information and then for it to not update when a worksheet is calculated.

All of the information is in the same workbook.

The below image is from a sheet called "Stock Codes"

The below image is from a sheet called "Full Sheet"

What I am trying to achieve is that when I enter a part number in D:D on "Full Sheet" it will bring the Total on Order amount from "Stock Codes" (S:S) into the Total on Order field on "Full Sheet" (K:K)

I would also like to get the Next Del Qty from "Stock Codes" (T:T) and Next Del Date from "Stock Codes" (U:U) to concatenate into the Next Delivery filed on "Full Sheet" (L:L)

I can do this using index match formulas but as mentioned above, I don't want these values to recalculate. I would like them to be taken at a point in time (when the part number is entered).

I already have this code, which time stamps cell C:C when D:D has info entered in "Full Sheet".

Any help would be very much appreciated.

 

[VBE313]

In column D in Full Sheet, Where is that information located? and what is under the data in column D?

 

[Click22]

In column D in Full Sheet, Where is that information located? and what is under the data in column D?

Sorry, I'm not sure I fully understand the question. In column D in Full Sheet, I will manually enter a part number (this is not necessarily the last line in column D).

That same part number is stored in column A in Stock Codes.

 

[VBE313]

Ok, well try this code, an input box will pop up and you will type your part number in there. But this will paste the answer in the last row of K and last row of L, I dont know where you want me to insert the data, from your example pictures, there is nothing under these rows, hence the reason I have it doing last row.

Option Explicit
Sub MrExcelDotCom()
Dim cl As Object, lastRow As Long, strCells As String, partNumber As String, _
totalOnOrder As String, nextDelQty As String
With Sheets("Full Sheet")
    lastRow = .Cells(Rows.Count, 4).End(xlUp).Row
    strCells = "D" & lastRow
    partNumber = InputBox("What part number do you want to search for?")
    With Sheets("Stock Codes")
        lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        strCells = "A1:A" & lastRow
        For Each cl In Sheets("Stock Codes").Range(strCells)
            If cl.Value = partNumber Then
                totalOnOrder = cl.Offset(0, 18).Value
                nextDelQty = cl.Offset(0, 19).Value & " " & cl.Offset(0, 20).Value
            End If
        Next cl
    End With
    lastRow = .Cells(Rows.Count, 11).End(xlUp).Row
    .Cells(lastRow, 11).Offset(1, 0).Value = totalOnOrder
    .Cells(lastRow, 12).Offset(1, 0).Value = nextDelQty
    .Columns("K:L").AutoFit
End With
End Sub

 

[Click22]

Ok, well try this code, an input box will pop up and you will type your part number in there. But this will paste the answer in the last row of K and last row of L, I dont know where you want me to insert the data, from your example pictures, there is nothing under these rows, hence the reason I have it doing last row.

Option Explicit
Sub MrExcelDotCom()
Dim cl As Object, lastRow As Long, strCells As String, partNumber As String, _
totalOnOrder As String, nextDelQty As String
With Sheets("Full Sheet")
    lastRow = .Cells(Rows.Count, 4).End(xlUp).Row
    strCells = "D" & lastRow
    partNumber = InputBox("What part number do you want to search for?")
    With Sheets("Stock Codes")
        lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        strCells = "A1:A" & lastRow
        For Each cl In Sheets("Stock Codes").Range(strCells)
            If cl.Value = partNumber Then
                totalOnOrder = cl.Offset(0, 18).Value
                nextDelQty = cl.Offset(0, 19).Value & " " & cl.Offset(0, 20).Value
            End If
        Next cl
    End With
    lastRow = .Cells(Rows.Count, 11).End(xlUp).Row
    .Cells(lastRow, 11).Offset(1, 0).Value = totalOnOrder
    .Cells(lastRow, 12).Offset(1, 0).Value = nextDelQty
    .Columns("K:L").AutoFit
End With
End Sub

That didn't seem to work either. Is there a way to upload an example file?

 

[Click22]

Hopefully this will clarify the intended outcome.
This is an example of the "Stock Codes" sheet

And this is what I would like the outcome to be when I add a part number into the "Full Sheet" page. Please note that the cell rows can be random as a certain amount of cells are pre-allocated to each user.
Ideally the code will be triggered when the part number is entered in column D.
It is only the H & I calculations that I require via VBA. If this can be added to the pre-existing code on the original post that would be ideal.

Thanks

 

[steve the fish]

Part of your problem here is that your example of the Stock Codes sheet in post #15 is different from the one in post #1. VBA is rubbish at guessing where your columns may sit.

 

[steve the fish]

Anyway for what you posted in post #15.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Range, myMatch As String

Set rng = Intersect(Target, Columns("D"))

If Not rng Is Nothing Then
    If rng.Cells.Count = 1 Then
        If Len(rng.Value) > 0 Then
            myMatch = Application.Match(rng.Value, Sheets("Stock Codes").Columns("A"), 0)
            If Not IsError(myMatch) Then
                rng.Offset(0, 4) = Sheets("Stock Codes").Cells(myMatch, "I")
                rng.Offset(0, 5) = Sheets("Stock Codes").Cells(myMatch, "J") & " on " & Sheets("Stock Codes").Cells(myMatch, "K")
            End If
        Else
            rng.Offset(0, 4) = vbNullString
            rng.Offset(0, 5) = vbNullString
        End If
    End If
End If

End Sub

 

[Click22]

Anyway for what you posted in post #15.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Range, myMatch As String

Set rng = Intersect(Target, Columns("D"))

If Not rng Is Nothing Then
    If rng.Cells.Count = 1 Then
        If Len(rng.Value) > 0 Then
            myMatch = Application.Match(rng.Value, Sheets("Stock Codes").Columns("A"), 0)
            If Not IsError(myMatch) Then
                rng.Offset(0, 4) = Sheets("Stock Codes").Cells(myMatch, "I")
                rng.Offset(0, 5) = Sheets("Stock Codes").Cells(myMatch, "J") & " on " & Sheets("Stock Codes").Cells(myMatch, "K")
            End If
        Else
            rng.Offset(0, 4) = vbNullString
            rng.Offset(0, 5) = vbNullString
        End If
    End If
End If

End Sub

Thanks Steve, that has worked a treat.
Appreciate your help.