Solved: How To Find "Max Value Of A Collection" ?

[Erdin? E. Ka]

Hi everyone,

I need an User definied function for find the "Max Value of a Collection". I resaerched on the net, Excel's help and tried some ways to solve but i couldn't succeed. Could you help me please?

[VBA]Public Function CountUniqueValues(InputRange As Range) As Long
Dim CeL As Range, UniqueValues As New Collection
Application.Volatile
On Error Resume Next
For Each CeL In InputRange
UniqueValues.Add CeL.Value, CStr(CeL.Value)
Next
On Error GoTo 0
CountUniqueValues = UniqueValues.Count
End Function[/VBA]

For example we can find teh count of a Collection via this UDF but i need max value of the collection.

Thanks in advance.

[Ken Puls]

Hi Erdinc,

I'm not sure I follow. You only seem to use the collection above to work with a range from a worksheet. It seems unnecessary, unless it is part of a bigger picture.

If you just need the max from a range, why not use:
[vba]Application.WorksheetFunction.Max(rng)[/vba]

[Erdin? E. Ka]

120-0095
120-0096
120-0097
320-0029
770-0034
120-0098
770-0035
770-0036
770-0037
770-0038
770-0039
120-0099
770-0040
120-0100
770-0041
770-0042
120-0101
320-0030
120-0102
770-0043
120-0103
320-0031
793-0006
120-0104
320-0032
990-0003
320-0033
320-0034

For example max value of 320's
In Azami Worksheet i split first 4 characters (from right side) ...

29
30
31
32
33
34


[vba]
Private Sub Che_Otomatik_Click()
Dim Sayfa As Worksheet, UcHane As Integer, ArananSatir As Long, _
Azami As Worksheet, i As Long, EklenenMetin As String, Hucre As Range
Set Sayfa = Workbooks("Cariler.xlsm").Worksheets("Cariler")
Set Azami = Workbooks("Cariler.xlsm").Worksheets("Azami")
On Error Resume Next
If Che_Otomatik.Value = True Then
If Len(txt_Ilk_Uc) >= 3 Then
Azami.Range("A:A").ClearContents
SonSatir = WorksheetFunction.CountA(Sayfa.Range("B:B"))
UcHane = CInt(Left(txt_Ilk_Uc.Value, 3))
i = 1
For Each Hucre In Sayfa.Range("B2:B" & SonSatir)
If CInt(Left(Hucre.Value, 3)) = UcHane Then
Azami.Cells(i, 1) = CInt(Right(Hucre.Value, 4))
i = i + 1
End If
Next
SonSatir = WorksheetFunction.CountA(Azami.Range("A:A"))
Sonuc = WorksheetFunction.Max(Azami.Range("A1:A" & SonSatir))
Select Case Len(Sonuc)
Case Is = 1: EklenenMetin = "000"
Case Is = 2: EklenenMetin = "00"
Case Is = 3: EklenenMetin = "0"
End Select
txt_CariKodu = Left(txt_Ilk_Uc.Value, 3) & "-" & EklenenMetin & Sonuc + 1
End If
End If
txt_CariAciklamasi.SetFocus
End Sub
[/vba]

Then i find "34".
And new value for new Account Code is: 320-0035


///////////////////


Hi Ken,

Fisrt of all i want to thank you to kindly help.

Actually i have already use that method. But i supposed there will be better and faster solution if i use a collection instead of a worksheet and WorksheetFunction.Max Method. But i am not sure that is a correct idea...

Anyway i sent my codes here. I added a worksheet and i seperated my datas to this worksheet then i used WF.Max Method for find maximum value of the all.

[Bob Phillips]

Erdin?,

Use an array, then you can use Application.Max on that array in VBA.

[Erdin? E. Ka]

Erdin?,

Use an array, then you can use Application.Max on that array in VBA.

Bob,

Ok, so i should use an array but how i can do that?

I think that i found a function ( from internet researching ) about my problem but i am not sure...

[VBA]
Function DevideArray(ByVal arrArg, Optional ElementMax As Long = 5461) As Variant
'Devide array as a variant array (make an array of arrays)
Dim lngNumofDiv As Long
Dim arrTempArray()
Dim buf()
Dim i As Long
Dim j As Long
lngNumofDiv = Application.WorksheetFunction.RoundUp(UBound(arrArg) / ElementMax, 0)
ReDim arrTempArray(1 To lngNumofDiv)
For j = 1 To lngNumofDiv
If j = lngNumofDiv Then
ReDim buf(1 To UBound(arrArg) - (lngNumofDiv - 1) * ElementMax)
For i = 1 To ElementMax
If UBound(arrArg) - (lngNumofDiv - 1) * ElementMax < i Then Exit For
buf(i) = arrArg(i + ElementMax * (j - 1), 1)
Next
Else
ReDim buf(1 To ElementMax)
For i = 1 To ElementMax
buf(i) = arrArg(i + ElementMax * (j - 1), 1)
Next
End If
arrTempArray(j) = buf
Erase buf
Next
DevideArray = arrTempArray
End Function
[/VBA]

Can we do something with it?

Thanks so much...

[Bob Phillips]

I think you need to explain a bit more what you are trying to do in ths procedure Erdin

[Charlize]

Not a function yet, but maybe something like this.[VBA]Sub find_next_value()
Dim cell As Range
Dim vno As Long
Dim searchno As Long
searchno = Application.InputBox("Give number before the '-'", _
"Apply new number ...", Type:=1)
For Each cell In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
If Str(Split(cell, "-")(0)) = Str(searchno) Then
If Val(Split(cell, "-")(1)) > vno Then
vno = Val(Split(cell, "-")(1))
End If
End If
Next cell
If vno = 0 Then
MsgBox "Searchvalue of " & searchno & _
" was not found !", vbInformation
Else
MsgBox "Highest value found for searchno " & _
searchno & " = " & Format(vno, "0000")
vno = vno + 1
Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1).Value = _
searchno & "-" & Format(vno, "0000")
End If
End Sub[/VBA]

[Erdin? E. Ka]

Hi Bob and Charlize,

I am so sorry 'cause i am late.

Charlize, your help is excellent, thank you very very much.

Bob, you interested about my problem, thank you too