Thread: [Solved] Macro or VBA to sort values
View Single Post
 
Old 05-02-2022, 08:24 AM
p45cal's Avatar
p45cal p45cal is online now Windows 10 Office 2019
Expert
 
Join Date: Apr 2014
Posts: 863
p45cal has a brilliant futurep45cal has a brilliant futurep45cal has a brilliant futurep45cal has a brilliant futurep45cal has a brilliant futurep45cal has a brilliant futurep45cal has a brilliant futurep45cal has a brilliant futurep45cal has a brilliant futurep45cal has a brilliant futurep45cal has a brilliant future
Default

Also at https://www.msofficeforums.com/excel...rt-values.html

Code:
Sub blah()
StartChars = Array("AB", "BC", "CD", "DE") 'what you're looking for
Set Destn = Range("D2")    'top left of area where results will go.
'Find range to process:
Set Rng = Range("B6").End(xlDown)
If IsEmpty(Rng.Value) Then
  Set Rng = Range("B6")
Else
  Set Rng = Range(Range("B6"), Rng)
End If
'Create the results in-memory:
ReDim Results(1 To UBound(StartChars) - LBound(StartChars) + 1)
For Each cll In Rng.Cells
  colm = Application.Match(Left(Application.Trim(cll.Value), 2), StartChars, 0)
  If Not IsError(colm) Then
    If IsEmpty(Results(colm)) Then Set Results(colm) = CreateObject("Scripting.Dictionary")
    Results(colm).Add cll.Value & Rnd, cll.Value
  End If
Next cll
colm = 0
'determine size of area to clear for the results:
maxRows = 0
For Each result In Results
  maxRows = Application.Max(result.Count, maxRows)
Next result
'clear that area (+1 blank row):
Destn.Resize(maxRows + 1, UBound(Results)).Clear
For Each result In Results
  Destn.Offset(, colm).Resize(result.Count).Value = Application.Transpose(result.items)
  colm = colm + 1
Next result
End Sub

I suspect I'll give ntldr123 a wide berth in the future since he'll probably already have a solution elsewhere.
Reply With Quote