Find the highest value from range, multiple entry and adjacent cells date

[Anbuselvam]

Hi

In the excel sheet, I have the date in J8:J9999 and Invoice number in the Column K8:K9999.

Invoice number having 4 series as below,
1 to 1000
1001 to 4000
4001 to 5000
10000 to 15000

Invoice number entry will be like this
1&2&3
1005
1006&1007&1008
4004
4005&4006&4007

I used a formula in R4 to find the highest value from 4000 to 5000 is
=AGGREGATE(14,6,K8:K9999/(K8:K9999>=4001)/(K8:K9999<=5000),1)

My expected value in R4 is 4007 (highest value between 4000 to 5000) but it is showing 4004 because it is ignoring to take 4005&4006&4007 entry.

How do I change the formula to get the 4007 in cell R4?

Note: The entry from 4000 to 5000 will be the year of 2019 entries only. I don't know how to get the highest value from this year entry as well as multiple entries too.

Please suggest the formula

Thanks in advance

Sincerely Yours
Anbuselvam K

 

[kvsrinivasamurthy]

Here is the code for UDF for Missing Numbers.
There are many duplicates in numbers.

Function MissingNos(DateRng As Range, Year_ As Integer, NumRng As Range) As String

Dim cel As Range
Dim T As Long, TA As Long, TB As Long
Dim Ary As Object


Set Ary = CreateObject("System.Collections.ArrayList")
T = 1
For Each cel In NumRng


    If Year(DateRng.Cells(T, 1)) = Year_ Then
    M = Split(cel, "&")
    
    For TA = 0 To UBound(M)
    
    If 0 + M(TA) > 0 Then
    Ary.Add M(TA) + 0
    End If
    
    Next TA
    
    End If
T = T + 1
Next cel


Ary.Sort


For TA = Ary.Item(0) To Ary.Item(Ary.Count - 2)
zz = Ary.Item(0 + TB)


If Ary.Item(TB) = Ary.Item(1 + TB) Then
TB = TB + 1
TA = TA - 1
Else


    If TA <> Ary.Item(0 + TB) Then
    MissingNos = MissingNos & "," & TA
    Else
    TB = TB + 1
    End If


End If
Next TA


If MissingNos <> "" Then MissingNos = Mid(MissingNos, 2)
End Function

 

[kvsrinivasamurthy]

Post deleted.

 

[Anbuselvam]

Please check the below link file

https://www.dropbox.com/s/fpplx15jb9f53go/Highest value with VB Code.xlsm?dl=0

I think it is required small modification as like last time.

Please do the needful.

Here is the code for UDF for Missing Numbers.
There are many duplicates in numbers.

Function MissingNos(DateRng As Range, Year_ As Integer, NumRng As Range) As String

Dim cel As Range
Dim T As Long, TA As Long, TB As Long
Dim Ary As Object


Set Ary = CreateObject("System.Collections.ArrayList")
T = 1
For Each cel In NumRng


    If Year(DateRng.Cells(T, 1)) = Year_ Then
    M = Split(cel, "&")
    
    For TA = 0 To UBound(M)
    
    If 0 + M(TA) > 0 Then
    Ary.Add M(TA) + 0
    End If
    
    Next TA
    
    End If
T = T + 1
Next cel


Ary.Sort


For TA = Ary.Item(0) To Ary.Item(Ary.Count - 2)
zz = Ary.Item(0 + TB)


If Ary.Item(TB) = Ary.Item(1 + TB) Then
TB = TB + 1
TA = TA - 1
Else


    If TA <> Ary.Item(0 + TB) Then
    MissingNos = MissingNos & "," & TA
    Else
    TB = TB + 1
    End If


End If
Next TA


If MissingNos <> "" Then MissingNos = Mid(MissingNos, 2)
End Function

 

[kvsrinivasamurthy]

Your file working ok for me. Pl check step by step. Find out which step is giving problem and what is the error.
Restrict the range J8:J12.
Give break for the line -- > Set Ary = CreateObject("System.Collections.ArrayList")
Then use F8 key to go step by step

 

[Anbuselvam]

Dear KVSM

Frankly speaking, I do not have much experience in VB code and all. So here I request you to send me the final code or excel file which is working fine there.

Thanks in advance

Your file working ok for me. Pl check step by step. Find out which step is giving problem and what is the error.
Restrict the range J8:J12.
Give break for the line -- > Set Ary = CreateObject("System.Collections.ArrayList")
Then use F8 key to go step by step

 

[kvsrinivasamurthy]

The file You have sent is working ok without any problem.

 

[kvsrinivasamurthy]

The file You have sent is working ok without any problem.
Perhaps Createobject(System.collections.Arraylist) may be having problem. I will try to get alternative code.

 

[Anbuselvam]

Please check the screenshot and the error showing #VALUE !

Could you please share the file which is working with you.

https://www.dropbox.com/s/qg3vrleie5wvmik/Screenshot 2019-01-10 12.14.21.png?dl=0

https://www.dropbox.com/s/oa3hngrerrj7ovm/Screenshot 2019-01-10 12.14.32.png?dl=0

The file You have sent is working ok without any problem.

 

[Anbuselvam]

Thanks a lot. I am waiting for your reply.

The file You have sent is working ok without any problem.
Perhaps Createobject(System.collections.Arraylist) may be having problem. I will try to get alternative code.

 

[kvsrinivasamurthy]

Try this code.

Function MissingNos(DateRng As Range, Year_ As Integer, NumRng As Range) As String


Dim cel As Range
Dim T As Long, TA As Long, MinVal As Long, MaxVal As Long
Dim VfyStr As String


T = 1
For Each cel In NumRng


    If Year(DateRng.Cells(T, 1)) = Year_ Then
    VfyStr = VfyStr & "&" & cel
    M = Split(cel, "&")
    
    For TA = 0 To UBound(M)
    
    If 0 + M(TA) > 0 Then
    If MinVal = 0 Then MinVal = 0 + M(TA)
    MinVal = WorksheetFunction.Min(0 + M(TA), MinVal)
    MaxVal = WorksheetFunction.Max(0 + M(TA), MaxVal)
    End If
    
    Next TA
    
    End If
T = T + 1
Next cel


VfyStr = VfyStr & "&"


For TA = MinVal + 1 To MaxVal - 1
    
    If InStr(1, VfyStr, "&" & TA & "&") = 0 Then
    MissingNos = MissingNos & "," & TA
    End If


Next TA


If MissingNos <> "" Then MissingNos = Mid(MissingNos, 2)
End Function