Get first and last number in ID sequence and name of product and display in another worksheet

Question

I have one worksheet "Blanco List" that display combined data from 35 worksheets on condition in column range "A:F" and x rows. Row number can vary when i update that sheet. What i need is to search for every ID sequence in column "A" and the name of each product that is in column "B", and find first and last ID number in sequice and get product name that belongs to that IDs. Then, display result in worksheet"ReadyTG". I tried with excel functions Min, Max, and VlookUp, but i need to expand formula range every time when row number changes. So i need some VBA solution for this. Screenshoot of wanted result
Workbook Example is in this link: https://easyupload.io/o648lb

Thanks in advance!

Answer 1

First generate a Pivot table, then you obtain all unique serial numbers. Run this VBA to generate the formulas and repast the values from them. You have to run the VBA script every time a value changes.

Sheets("ReadyTG").Select
For i = 3 To 10 'row
    Range("L" & i).FormulaArray = "=MIN(IF('Blanko List'!C7=RC[-1],'Blanko List'!C8))"
    Range("L" & i).Value = Range("L" & i).Value
    Range("M" & i).FormulaArray = "=MAX(IF('Blanko List'!C7=RC[-2],'Blanko List'!C8))"
    Range("M" & i).Value = Range("M" & i).Value
Next i

Answer 2

If it's a question of performance because Excel keeps on evaluating thousands of formulas, you can use the following to interrupt automatic formula calculation (first line) and calculate everything on save (second line).

Application.Calculation = xlCalculationManual
Application.CalculateBeforeSave = True

---

If you still wish to calculate max and min using VBA, considering that names are in cells J3 and below:

Sub MinMax()
    Dim oNameCell As Cell
    Dim oCell As Cell
    Dim No As Long

    For Each oNameCell in Range("J3", Range("J3").End(xlDown))
        For Each oCell in Range("B2", Range("B2").End(xlDown))
            If oNameCell = oCell Then
                No = Split(oNameCell.Offset(, -1), "-")(1)
                If No < oNameCell.Offset(, 1) Then _
                    oNameCell.Offset(, 1) = No
                If No > oNameCell.Offset(, 2) Then _
                    oNameCell.Offset(, 2) = No
            End If
        Next oCell
    Next oSNCell
End Sub

Naturally, you'll have to re-run this macro every time new data is entered.

Maybe see Assign a macro to a button.

Answer 3

Its not rly an answer, but i made code with Macro recored, and it works job for me. If someone have idea how to make this code simpler, im glad to hear it. This thing rly needs an optimization.

Sub Macro6()

'call macro8 to prevent any calculations on sheet "ReadyTG" and to clear old 
values
Call Macro8


'finding last row in sheet "Blanko List"
Dim lRow As Long, sht As Worksheet
Set sht = Worksheets("Blanko List")
lRow = sht.Range("A2").CurrentRegion.Rows.Count

'Macro recored while doing option from Data tab > Text To Columns, to separate 
'value from column A
'into 2 part, value before "-" and after "-"

sht.Range("A2", sht.Range("A2" & lRow)).Select
Selection.TextToColumns Destination:=Range("G2"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
    :="-", FieldInfo:=Array(Array(1, 1), Array(2, 1)), 
  TrailingMinusNumbers:=True
    
 'Advance fileter to remove duplicates from column "G"
 'so that Hlookup function can do its job

 sht.Range("G2", sht.Range("G2" & lRow)).Select
 sht.Range("G2", sht.Range("G2" & lRow)).AdvancedFilter Action:=xlFilterCopy, 
 CopyToRange:=Range("I2" _
    ), Unique:=True
    
    'There is a problem in range or something with AdvanceFilter, it returns 2 values of same Product name in first 2 rows
    Columns("I:I").Select
ActiveSheet.Range("$I$2:$I$58").Removeduplicates Columns:=1, Header:=xlNo

End Sub
 '-----------------------------------------------------------------------------




  Sub Macro7()
 'Return name and serial number in columns A and B from sheet "Blanko List"
 ' and runs array forumula  to get first and last number of ID sequince
 'also it autofill rows with funcitons up to 60 rows, because i don t know the 
 last row

 Range("A2").Select
 ActiveCell.FormulaR1C1 = _
    "=IFNA(VLOOKUP(RC[1]&""*"",'Blanko List'!C:C[1],2,FALSE),"""")"
 Range("B2").Select
 ActiveCell.FormulaR1C1 = _
    "=IFNA(HLOOKUP(R1C2,'Blanko List'!C[7],ROW(RC),FALSE),"""")"
 Range("C2").Select
 Selection.FormulaArray = _
    "=MIN(IF('Blanko List'!C[4]=RC[-1],'Blanko List'!C[5]))"
 Range("D2").Select
 Selection.FormulaArray = "=MAX(('Blanko List'!C[3]=RC[-2])*'Blanko List'!C[4])"
 Range("A2:D2").Select
 Selection.AutoFill Destination:=Range("A2:D59"), Type:=xlFillDefault
 Range("A2:D59").Select


  End Sub
 '-------------------------------------------------------

 Sub Macro8()
 'clears all existing formulas and values in target sheet for better performance
 'calculating time before this 3 minutes

 ThisWorkbook.Worksheets("ReadyTG").Select
 Rows("2:160").Select
 Selection.Delete Shift:=xlUp
 ThisWorkbook.Worksheets("Blanko List").Select

 End Sub

Answer 4

You can obtain your desired output using Power Query, available in Windows Excel 2010+ and Office 365 Excel

• Select some cell in your original table
• Data => Get&Transform => From Table/Range
• When the PQ UI opens, navigate to Home => Advanced Editor
• Make note of the Table Name in Line 2 of the code.
• Replace the existing code with the M-Code below
• Change the table name in line 2 of the pasted code to your "real" table name
• Examine any comments, and also the Applied Steps window, to better understand the algorithm and steps

M Code

let

//change table name in next line to actual table name in your workbook
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],

//set the data types
    #"Changed Type" = Table.TransformColumnTypes(Source,{
        {"Serial Number", type text}, {"Name", type text}, {"Quantity", Int64.Type}, 
        {"ME/JM", type text}, {"Status", type text}, {"Date of entry", type date}},
         "en-150"),

//split the serial number column on the delimiter
//Only the first delimiter since I don't know what to do with sn's with multiple hyphens
    #"Split Column by Delimiter" = Table.SplitColumn(#"Changed Type", "Serial Number", 
        Splitter.SplitTextByDelimiter("-", QuoteStyle.Csv), {"Serial Number", "Serial Number.2"}),

//set data types to numbers so we can get Min and Max
    #"Changed Type1" = Table.TransformColumnTypes(#"Split Column by Delimiter",{
        {"Serial Number", Int64.Type}, {"Serial Number.2", Int64.Type}}),

//Group by Name and main serial number
//extract the min and max of part2 of the serial number
    #"Grouped Rows" = Table.Group(#"Changed Type1", {"Name", "Serial Number"}, {
        {"First", each List.Min([Serial Number.2]), Int64.Type}, 
        {"Last", each List.Max([Serial Number.2]), Int64.Type}})
in
    #"Grouped Rows"

Results from the data in your uploaded file