jski
Board Regular
- Joined
- Jan 11, 2006
- Messages
- 118
I have code that performs a custom sort and it work fine. I'm finding that I need to insert 3 rows after a certain value in the sort. The sticky point is the value may not appear in the data at times, so I would need to insert the 3 rows after the next found custom sort value that appears before the unfound string. Here's the code snippet:
The logic here would be to insert 3 rows below the last instance found in the column. However, for the string series below, I need to evaluate if the last string value exists and if so, insert the rows. If not, move to the next string value above, find the last instance of that and insert the rows. If that string value is not found, move to the next string value above, etc.
sCustomList(2) = "A"
sCustomList(3) = "B" (if not found, move to "A" and insert the rows)
sCustomList(4) = "C" (if not found, move to "B" and insert the rows)
sCustomList(5) = "D" (if not found, move to "C" and insert the rows)
sCustomList(6) = "E"
sCustomList(7) = "F" (if not found, move to "E" and insert the rows)
sCustomList(8) = "G" (if not found, move to "F" and insert the rows)
sCustomList(9) = "H" (if not found, move to "G" and insert the rows)
sCustomList(11) = "I"
sCustomList(12) = "J" (if not found, move to "I" and insert the rows)
sCustomList(13) = "K" (if not found, move to "J" and insert the rows)
sCustomList(14) = "L" (if not found, move to "K" and insert the rows)
Hope this makes sense. I'm thinking of a loop and have not worked with those as of yet. As always, many thanks in advance for all who visit this post and offer their consideration and expertise.
jski
Code:
' Arrange rows by regions
Dim oWorksheet As Worksheet
Set oWorksheet = ActiveWorkbook.Worksheets("Pipeline Detail 1")
Dim oRangeSort As Range
Dim oRangeKey As Range
' One range that includes all columns to sort
Set oRangeSort = oWorksheet.Range("A2:S" & Rows.Count).End(xlUp)
' Start of column with keys to sort
Set oRangeKey = oWorksheet.Range("H1")
' Custom sort order
Dim sCustomList(1 To 14) As String
sCustomList(1) = "123"
sCustomList(2) = "A"
sCustomList(3) = "B"
sCustomList(4) = "C"
sCustomList(5) = "D"
sCustomList(6) = "E"
sCustomList(7) = "F"
sCustomList(8) = "G"
sCustomList(9) = "H"
sCustomList(10) = "456"
sCustomList(11) = "I"
sCustomList(12) = "J"
sCustomList(13) = "K"
sCustomList(14) = "L"
Application.AddCustomList ListArray:=sCustomList
' Use this if you want a list on the spreadsheet to sort by
' Application.AddCustomList ListArray:=Range("D1:D3")
oWorksheet.Sort.SortFields.Clear
oRangeSort.Sort Key1:=oRangeKey, Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=Application.CustomListCount + 1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
' Clean up
Application.DeleteCustomList Application.CustomListCount
Set oWorksheet = Nothing
The logic here would be to insert 3 rows below the last instance found in the column. However, for the string series below, I need to evaluate if the last string value exists and if so, insert the rows. If not, move to the next string value above, find the last instance of that and insert the rows. If that string value is not found, move to the next string value above, etc.
sCustomList(2) = "A"
sCustomList(3) = "B" (if not found, move to "A" and insert the rows)
sCustomList(4) = "C" (if not found, move to "B" and insert the rows)
sCustomList(5) = "D" (if not found, move to "C" and insert the rows)
sCustomList(6) = "E"
sCustomList(7) = "F" (if not found, move to "E" and insert the rows)
sCustomList(8) = "G" (if not found, move to "F" and insert the rows)
sCustomList(9) = "H" (if not found, move to "G" and insert the rows)
sCustomList(11) = "I"
sCustomList(12) = "J" (if not found, move to "I" and insert the rows)
sCustomList(13) = "K" (if not found, move to "J" and insert the rows)
sCustomList(14) = "L" (if not found, move to "K" and insert the rows)
Hope this makes sense. I'm thinking of a loop and have not worked with those as of yet. As always, many thanks in advance for all who visit this post and offer their consideration and expertise.
jski