Find cell with lowest last number

[Lewiskj]

Hard to explain what I'm trying to do in the title.

There is a link to the screenshot below, I'm having problems trying to add the image to this post

In column F: i want to find the cell with the lowest last number.
In this case it is F1791 as highlighted.
The last number could be anything from 1 digit to 5 digits long

Screenshot
https://1drv.ms/u/s!AnlQC4WN-LeXoyc3VENJAv7JUulb

 

[Rick Rothstein]

At the end of every row there is a space after the last comma, not sure if this will effect anything that you're code is looking for.

Yep, it does. Give this revision a try...

Sub LowestLastNumber()
  Dim R As Long, LastRow As Long, MinNum As Long, RowNum As Variant, LastNum As Variant, Data As Variant
  LastRow = Cells(Rows.Count, "F").End(xlUp).Row
  Data = Range("F1:F" & LastRow)
  MinNum = Evaluate("MIN(0+TRIM(LEFT(RIGHT(SUBSTITUTE(F2:F7,"","",REPT("" "",100)),200),100)))")
  For R = 1 To UBound(Data)
    If Data(R, 1) Like "*, " Then
      LastNum = Split(Data(R, 1), ", ")
      LastNum = LastNum(UBound(LastNum) - 1)
      If LastNum = MinNum Then RowNum = RowNum & ", " & R
    End If
  Next
  RowNum = Mid(RowNum, 3)
  
  MsgBox "Minimum Number Row(s): " & RowNum
  
End Sub

 

[Lewiskj]

Yep, it does. Give this revision a try...

Sub LowestLastNumber()
  Dim R As Long, LastRow As Long, MinNum As Long, RowNum As Variant, LastNum As Variant, Data As Variant
  LastRow = Cells(Rows.Count, "F").End(xlUp).Row
  Data = Range("F1:F" & LastRow)
  MinNum = Evaluate("MIN(0+TRIM(LEFT(RIGHT(SUBSTITUTE(F2:F7,"","",REPT("" "",100)),200),100)))")
  For R = 1 To UBound(Data)
    If Data(R, 1) Like "*, " Then
      LastNum = Split(Data(R, 1), ", ")
      LastNum = LastNum(UBound(LastNum) - 1)
      If LastNum = MinNum Then RowNum = RowNum & ", " & R
    End If
  Next
  RowNum = Mid(RowNum, 3)
  
  MsgBox "Minimum Number Row(s): " & RowNum
  
End Sub

Works like a charm, thank you for you're help

 

[Lewiskj]

	F
1	997, 1215, 1462, 1693, 2416, 3521, 3603, 4243, 5257, 5617, 5726, 6004, 6495, 6559, 6587,
2	997, 1205, 2720, 3603, 4040, 4981, 5257, 5344, 5407, 6609,
3	996, 1958, 2123, 2543, 2896, 3562, 3571, 4292, 4844, 5028, 5256, 6745,
4	996, 1273, 1599, 2069, 2627, 2720, 3571, 3945, 4982, 5700, 6090, 6141, 6386, 6500, 6745,
5	996, 1224, 1874, 1976, 2008, 2627, 3164, 3550, 3657, 4105, 4126, 4237, 4312, 4413, 4525, 4550, 6571,
6	996, 1096, 1216, 1553, 2173, 2200, 2590, 3164, 3240, 3550, 3551, 4749, 4775, 4942, 5066, 5121, 5125, 5525, 5900, 6090, 6141, 6152, 6500, 6620, 6794,
7	996, 1224, 1874, 1976, 2008, 2627, 3164, 3550, 3657, 4105, 4126, 4237, 4312, 4413, 4525, 4550, 6571,
8	996, 1048, 1438, 1705, 1874, 1911, 2149, 2536, 2695, 2896, 3157, 3556, 3602, 3692, 3959, 5593,
9	996, 1032, 1645, 2057, 2420, 2643, 3351, 3460, 5139,
10	995, 1376, 1540, 1570, 1826, 2011, 2126, 2251, 2269, 2576, 2696, 2874, 3030, 3496, 4045, 5882, 5979, 6118, 6291, 6560,
11	995, 1369, 1716, 2232, 2252, 3163, 3179, 3991, 4029, 4156, 4374, 4458, 5556, 5581, 6423, 6592, 5659,

<colgroup><col style="width: 25pxpx"><col></colgroup><thead>
</thead><tbody>
</tbody>

Sheet2​

I just noticed it's not finding lowest numbers.
As the image shows it'll say row 5 & 7 are the lowest but 8, 9, 10 &11 have a lower last number.
I see F2:F7 in you're code, is this limiting it?

 

[Rick Rothstein]

I see F2:F7 in you're code, is this limiting it?

Argh, I forgot to change that early on in my testing when I introduced the LastRow variable in order to generalize the code.

Sorry! Give this version a try...

Sub LowestLastNumber()
  Dim R As Long, LastRow As Long, MinNum As Long, RowNum As Variant, LastNum As Variant, Data As Variant
  LastRow = Cells(Rows.Count, "F").End(xlUp).Row
  Data = Range("F1:F" & LastRow)
  MinNum = Evaluate(Replace("MIN(IF(F2:F#="""","""",0+TRIM(LEFT(RIGHT(SUBSTITUTE(F2:F#,"","",REPT("" "",100)),200),100))))", "#", LastRow))
  For R = 1 To UBound(Data)
    If Data(R, 1) Like "*,*" Then
      LastNum = Split(Data(R, 1), ",")
      LastNum = LastNum(UBound(LastNum) - 1)
      If LastNum = MinNum Then RowNum = RowNum & ", " & R
    End If
  Next
  RowNum = Mid(RowNum, 3)
  
  MsgBox "Minimum Number Row(s): " & RowNum
  
End Sub

 

[Lewiskj]

Argh, I forgot to change that early on in my testing when I introduced the LastRow variable in order to generalize the code.

Sorry! Give this version a try...

Sub LowestLastNumber()
  Dim R As Long, LastRow As Long, MinNum As Long, RowNum As Variant, LastNum As Variant, Data As Variant
  LastRow = Cells(Rows.Count, "F").End(xlUp).Row
  Data = Range("F1:F" & LastRow)
  MinNum = Evaluate(Replace("MIN(IF(F2:F#="""","""",0+TRIM(LEFT(RIGHT(SUBSTITUTE(F2:F#,"","",REPT("" "",100)),200),100))))", "#", LastRow))
  For R = 1 To UBound(Data)
    If Data(R, 1) Like "*,*" Then
      LastNum = Split(Data(R, 1), ",")
      LastNum = LastNum(UBound(LastNum) - 1)
      If LastNum = MinNum Then RowNum = RowNum & ", " & R
    End If
  Next
  RowNum = Mid(RowNum, 3)
  
  MsgBox "Minimum Number Row(s): " & RowNum
  
End Sub

Works great now, doing exactly what i wanted.