Calling routine required for previous Post and following Post
Code:Sub Call_Sub_BubblesIndexIdeaWay() ' Partially hard coded for ease of explanation ' data range info Dim WsS As Worksheet: Set WsS = ThisWorkbook.Worksheets("Sorting") Dim RngToSort As Range: Set RngToSort = WsS.Range("B11:E16") ' Set RngToSort = Selection ' ' Selection.JPG : https://imgur.com/HnCdBt8 Dim arrTS() As Variant ' This is somewhat redundant for this version and could be replaced by arrOrig() Let arrTS() = RngToSort.Value ' Index idea variables Let arrOrig() = arrTS() Let arrIndx() = arrTS() Let Cms() = Evaluate("=Column(A:D)") ' Convenient way to get Let Rs() = Evaluate("=Row(1:6)") ' Initial row indicies ' Add initial indicies Let RngToSort.Offset(-1, 0).Resize(1, 4).Value = Cms(): RngToSort.Offset(-1, 0).Resize(1, 4).Font.Color = vbRed Let RngToSort.Offset(0, -1).Resize(6, 1).Value = Rs(): RngToSort.Offset(0, -1).Resize(6, 1).Font.Color = vbRed ' Initial row indicies from full original range´of rows Dim strRows As String, Cnt As Long: Let strRows = " " For Cnt = 1 To 6 Let strRows = strRows & Rs(Cnt, 1) & " " Next Cnt ' we should have now strRows = " 1 2 3 4 5 6 " Call BubblesIndexIdeaWay(1, arrIndx(), strRows, " 1 Asc 3 Asc 2 Asc ") ' Call BubblesIndexIdeaWay(1, arrIndx(), strRows, " 1 Asc ") ' Call BubblesIndexIdeaWay(1, arrIndx(), strRows, " 1 Asc 3 Asc ") ' Demo output Dim RngDemoOutput As Range: Set RngDemoOutput = WsS.Range("B31").Resize(RngToSort.Rows.Count, RngToSort.Columns.Count) ' Let WsS.Range("B31").Resize(RngToSort.Rows.Count, RngToSort.Columns.Count).Value = arrIndx() Let RngDemoOutput = arrIndx() Let RngDemoOutput.Offset(-1, 0).Resize(1, 4).Value = Cms(): RngToSort.Offset(-1, 0).Resize(1, 4).Font.Color = vbRed Let RngDemoOutput.Offset(0, -1).Resize(6, 1).Value = Rs(): RngToSort.Offset(0, -1).Resize(6, 1).Font.Color = vbRed End Sub




Reply With Quote
Bookmarks