VBA to Find Occurence of Word, Then Custom Sort LOOP

crock · Feb 12th 2020

Hello! I'm trying to create VBA code to essentially do:

1. "Find" search for the word "Offer ID"

2. Select that row and then "SHIFT+DOWNARROW" to select all rows from "Offer ID" until the next blank cell

3. "Custom Sort" based on the values in Column N

4. Loop back to step 1 and find the next occurrence of the "Offer ID"

I tried to piece together some VBA code from a few different projects and from manually doing it using the "Record Macro" button to create the code, but I keep hitting road blocks. I'm looking at the "Range("A" & c & ":T")" portion and I'm sure that's part of the problem. In theory, I was hoping that code translated to grab A:T for the row of the current occurrence of "Offer ID" (ie: if the macro has found "Offer ID" on Row 20, it would be grabbing A20:T20. Then End(xlDown).Select would select all cells below until the next blank row. However, I think there might be a slew of problems with the sorting logic. I set Key:=Columns(14) to represent sorting based on the values in Column N, which is the 14th column over.

Code

Sub AlphaSORT()
'
'
'
Dim LastRow As Integer
Dim Offer ID As String

With Worksheets("Backup").Range("A1:A15000")
Set c = .Find(What:="Offer ID", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Range("A" & c & ":T").End(xlDown).Select
ActiveWorkbook.Worksheets("Backup").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Backup").Sort.SortFields.Add2 Key:=Columns(14), _
Order:=xlAscending, Orientation:=xlTopToBottom, Header:=xlYes, MatchCase:=False, DataOption:= _
xlSortNormal, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Backup").Sort
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
Set c = .FindNext(c)
If c Is Nothing Then
GoTo DoneFinding
End If
Loop While c.Address <> firstAddress
End If
DoneFinding:

End With

End Sub

Display More

davesexcel · Feb 17th 2020

Assuming you need to use the find, instead of using rangeAreas

Code

Sub AlphaSORT()
  Dim wdCnt As Long
  Dim NxtC As Long
  Dim rng As Range
  Dim FndWrd As String
  Dim c As Range, NewC As Range, Nxt As Long
  Dim sh As Worksheet
  
  Set sh = Sheets("Backup")
  
  With sh
    FndWrd = "Offer ID"
    Set rng = .Range("A:A")
    wdCnt = Application.WorksheetFunction.CountIf(rng, FndWrd)
    Nxt = 1
    If Not wdCnt = 0 Then
    
      Do
        Set c = rng.Find(what:=FndWrd, After:=.Range("A" & Nxt))
        NxtC = NxtC + 1
        If Not c Is Nothing Then
        
          Set NewC = Range(c.Resize(, 20), c.Resize(, 20).End(xlDown))
          
          With ActiveSheet
            .Sort.SortFields.Clear
            .Sort.SortFields.Add2 Key:=NewC.Columns(14), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            With .Sort
              .SetRange NewC
              .Header = xlYes
              .MatchCase = False
              .Orientation = xlTopToBottom
              .SortMethod = xlPinYin
              .Apply
            End With
          End With
          
        End If
        Nxt = c.Row + 1
      Loop While Not NxtC >= wdCnt
    End If
  End With
End Sub

Display More

crock · Feb 18th 2020

omg, this worked PERFECTLY. thank you so much, I spent 2 weeks trying to figure this out on my own. Much appreciated!

VBA to Find Occurence of Word, Then Custom Sort LOOP

Participate now!

Share

Tags

Users Viewing This Thread