Search code examples
excelvbatextnumbers

Need to find max value with text & number combination


I have some data in a column of excel sheet. (Text-Number combination) Like:

AAA-32 
BBB-54
AAA-221
CCC-05
DDD-212

Text would be always 3 characters long & is always followed by a " - " then a number.

I need to find max value for AAA, BBB, CCC ..& other texts that has largest number.

Max value for AAA is "AAA-221", similarly want for other characters (BBB,CCC..)

How can achieve it using VBA ?

`Data is present in column A
'lRow = Last Row
`tchar contains no. of unique characters, here 4 (AAA,BBB,CCC,DDD)

Dim i as Integer, tchar as Integer, tArray() as String, rng as Range

'Copying unique characters from col A into col Z. (Ignore Cell A1, Z1)
Range("A2:A" & lRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("Z2"), Unique:=True

'To get tchar
Range("Z2").Select
Range(Selection, Selection.End(xlDown)).Select
tchar = Selection.Rows.Count

'Range with unique characters
Set rng = Range("Z2", "Z" & lRow)

'Re-Define array
ReDim tArray(tchar)

'Getting unique characters into array
For i = 1 To tchar
tArray(i) = rng.Item(i).Value
Next i

'Separated Text & Numbers  into col B & C
'Col B has text (AAA,BBB...)
'Col C has numbers (32, 54, 221 ..)

'Now to use tArray() to traverse in col B & get max value from col C

'**I am stuck here**


Solution

  • The task looks like a classic case for using a Dictionary object

    Option Explicit
    
    Sub SelectMax()
        Dim Key As String, Value As Long, x As Variant, a As Variant, cnt As Long
        Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
        
        With ThisWorkbook.Worksheets("Sheet1")
            For Each x In Intersect(.Columns("A"), .UsedRange)
                a = Split(x, "-")
                
                Key = a(0): Value = Val(a(1))
                
                If dict.exists(Key) Then
                    If Value > dict(Key) Then dict(Key) = Value
                Else
                    dict.Add Key, Value
                End If
            Next
            
            ' output the result
            Range("B1") = "Max" 'header
            cnt = 1
            For Each x In dict.Keys
                Range("B1").Offset(cnt) = x & "-" & dict(x)
                cnt = cnt + 1
            Next
        End With
    End Sub
    

    enter image description here