Finding Max & Min for varying lines in a list VBA excel - vba

Question

I'm having trouble turning my thought process into tangible code and honestly I'm not sure where to start with the code. I have a data set with two applicable columns, for the sake of simplicity we'll say A and B. A contains a list of three initials followed by a number, ex. JFD3, JFD2, JFD6, EUW1, YMG2, YMG3. Column B has a value. I need to find the range of the highest to lowest values for each set of initials, which has me thinking a max - min solution. The list of initials isn't necessarily in order, and there could be one set of initials(with a net variance of 0, which is OK), or up to 8 sets of initials, with the numbers not necessarily being consecutive. I was thinking some sort of Match(Left(3)) but i don't think that would encompass everything.
Any ideas on where to start would be much appreciated. I'll be happy to clarify if theres any questions.

Answer 1

You can use dictionaries from the Scripting Runtime to do this easily. Use two of them with the initials as the keys, one holding the minimum values found and the other holding the maximum values found.
Add a reference to the Microsoft Scripting Runtime (Tools->Add reference..., then check the box next to "Microsoft Scripting Runtime") or late bind (see instructions below). Something like this should do the trick, assumes initials in column 1, values in column 2, no headers:
Private Sub MinMax()
Dim mins As Dictionary
Dim maxes As Dictionary
Dim sheet As Worksheet
Set sheet = ActiveSheet
Set mins = New Dictionary
Set maxes = New Dictionary
Dim row As Long
For row = 1 To sheet.UsedRange.Rows.Count
Dim key As Variant
Dim val As Integer
key = sheet.Cells(row, 1).Value2
If Len(key) >= 3 Then
key = Left$(sheet.Cells(row, 1).Value2, 3)
val = sheet.Cells(row, 2).Value2
If Not mins.Exists(key) Then
mins.Add key, val
Else
If mins(key) > val Then mins(key) = val
End If
If Not mins.Exists(key) Then
maxes.Add key, val
Else
If maxes(key) < val Then maxes(key) = val
End If
End If
Next row
For Each key In mins.Keys
Debug.Print key & ": Min = "; mins(key) & " Max = "; maxes(key)
Next key
End Sub
To use late binding, the code is exactly the same with these exceptions. Instead of declaring mins and maxes as Dictionary, declare them as Object:
Dim mins As Object
Dim maxes As Object
And instead of setting them as New Dictionary, use CreateObject:
Set sheet = ActiveSheet
Set mins = CreateObject("Scripting.Dictionary")
Set maxes = CreateObject("Scripting.Dictionary")

Answer 2

Use a Pivot Table. Put your Column A field* in the Row Labels, then put column B in the Values twice. Change one from Sum to Min, and the other from Sum to Max.
* Not sure if you need to group by JFD for all JFDx or by each JFDx. If you need them grouped by the 3 initials, make a column C =left("A1",3), then use that in your

Answer 3

An approach to this could be:
Sort the data in the range A-B by A in alphabetical order. To do this, you can record a macro while doing this action and edit the code to make it dynamically working every time. This is required to make the below solution work, more performing for many other kinds of similar approaches.
Use While blocks to run the solution. I let you take the time to build and test a working code, but this is the idea:
startSubset = 2 '<-- we start getting the key from row 2
'build the key to define the subset
keyStart = 1
currentKey = ""
Do While Not IsNumeric(Right(Left(Range("A" & startSubset),keyStart),1))
'while the last char of the key is not numeric, let's add it to the key
currentKey = currentKey & Right(Left(Range("A" & startSubset),keyStart),1)
keyStart = keyStart + 1
Loop
After the above, the key is stored in the variable currentKey. It will be JFD if the first cell is JFD213, etc. Hence, you loop until the end of this subset storing max and min in two variables:
min = 0
max = 0
Do While Left(Range("A" & startSubset),Len(currentKey)) = currentKey
If Range("B" & startSubset) < min Then min = Range("B" & startSubset)
If Range("B" & startSubset) > max Then max = Range("B" & startSubset)
startSubset = startSubset + 1
Loop
Once this is done, you just need to cast the values into a collection, for example:
myObs.Add(currentKey)
myObs.Add(min)
myObs.Add(max) '<-- you will get something like myObs = ("DJF", 0, 100)
Then cast this object into a bigger collection:
allValues.Add(myObs) '<-- at the end you will have something like this:
'allValues = [("DJF",0,100), ("ABC", 1, 75), ...]
and re-set the values to let them continue:
currentKey = ""
keyStart = 1
All the above, should be run in a While loop that will break when the data are over.
Please note the above code cannot work standing-alone, but it's rather a possible approach to the problem that you will need to re-work on your data to make it work in real life.