Sort more than one row

[Rubber Beaked Woodpecker]

The following code has been kindly provided by a fellow forum member, thank you sir

However this code only works for column A. The criteria for the rows to be sorted will still be in column A but how can i please adjust this code so that columns B:M are also sorted when the conditions are met in column A?

Many thanks

Sub SortIntoRows()

    Dim DataIn  As Variant
    Dim DataOut As Variant
    Dim Item    As Variant
    Dim ptrs()  As Long
    Dim rngBeg  As Range
    Dim rngEnd  As Range








        ReDim ptrs(1 To 31)
        ptrs(1) = 1
        ptrs(2) = 1000
        ptrs(3) = 2000
        ptrs(4) = 3000
        ptrs(5) = 4000
        ptrs(6) = 5000
        ptrs(7) = 6000
        ptrs(8) = 7000
        ptrs(9) = 8000
        ptrs(10) = 9000
        ptrs(11) = 10000
        ptrs(12) = 11000
        ptrs(13) = 12000
        ptrs(14) = 13000
        ptrs(15) = 14000
        ptrs(16) = 15000
        ptrs(17) = 16000
        ptrs(18) = 17000
        ptrs(19) = 18000
        ptrs(20) = 19000
        ptrs(21) = 20000
        ptrs(22) = 21000
        ptrs(23) = 22000
        ptrs(24) = 23000
        ptrs(25) = 24000
        ptrs(26) = 25000
        ptrs(27) = 26000
        ptrs(28) = 27000
        ptrs(29) = 28000
        ptrs(30) = 29000
        ptrs(31) = 30000
      
        ReDim DataOut(1 To 31000, 1 To 1)
        
    Set rngBeg = Range("A1")
    Set rngEnd = Cells(Rows.Count, "A").End(xlUp)
        If rngEnd.Row < rngBeg.Row Then Exit Sub
    
        DataIn = Range(rngBeg, rngEnd).Value
        
            For Each Item In DataIn
                Select Case Item
                    Case 101: DataOut(ptrs(1), 1) = Item: ptrs(1) = ptrs(1) + 1
                    Case 102: DataOut(ptrs(2), 1) = Item: ptrs(2) = ptrs(2) + 1
                    Case 103: DataOut(ptrs(3), 1) = Item: ptrs(3) = ptrs(3) + 1
                    Case 104: DataOut(ptrs(4), 1) = Item: ptrs(4) = ptrs(4) + 1
                    Case 105: DataOut(ptrs(5), 1) = Item: ptrs(5) = ptrs(5) + 1
                    Case 106: DataOut(ptrs(6), 1) = Item: ptrs(6) = ptrs(6) + 1
                    Case 107: DataOut(ptrs(7), 1) = Item: ptrs(7) = ptrs(7) + 1
                    Case 108: DataOut(ptrs(8), 1) = Item: ptrs(8) = ptrs(8) + 1
                    Case 109: DataOut(ptrs(9), 1) = Item: ptrs(9) = ptrs(9) + 1
                    Case 1010: DataOut(ptrs(10), 1) = Item: ptrs(10) = ptrs(10) + 1
                    Case 1011: DataOut(ptrs(11), 1) = Item: ptrs(11) = ptrs(11) + 1
                    Case 1012: DataOut(ptrs(12), 1) = Item: ptrs(12) = ptrs(12) + 1
                    Case 1013: DataOut(ptrs(13), 1) = Item: ptrs(13) = ptrs(13) + 1
                    Case 1014: DataOut(ptrs(14), 1) = Item: ptrs(14) = ptrs(14) + 1
                    Case 1015: DataOut(ptrs(15), 1) = Item: ptrs(15) = ptrs(15) + 1
                    Case 1016: DataOut(ptrs(16), 1) = Item: ptrs(16) = ptrs(16) + 1
                    Case 1017: DataOut(ptrs(17), 1) = Item: ptrs(17) = ptrs(17) + 1
                    Case 1018: DataOut(ptrs(18), 1) = Item: ptrs(18) = ptrs(18) + 1
                    Case 1019: DataOut(ptrs(19), 1) = Item: ptrs(19) = ptrs(19) + 1
                    Case 1020: DataOut(ptrs(20), 1) = Item: ptrs(20) = ptrs(20) + 1
                    Case 1021: DataOut(ptrs(21), 1) = Item: ptrs(21) = ptrs(21) + 1
                    Case 1022: DataOut(ptrs(22), 1) = Item: ptrs(22) = ptrs(22) + 1
                    Case 1023: DataOut(ptrs(23), 1) = Item: ptrs(23) = ptrs(23) + 1
                    Case 1024: DataOut(ptrs(24), 1) = Item: ptrs(24) = ptrs(24) + 1
                    Case 1025: DataOut(ptrs(25), 1) = Item: ptrs(25) = ptrs(25) + 1
                    Case 1026: DataOut(ptrs(26), 1) = Item: ptrs(26) = ptrs(26) + 1
                    Case 1027: DataOut(ptrs(27), 1) = Item: ptrs(27) = ptrs(27) + 1
                    Case 1028: DataOut(ptrs(28), 1) = Item: ptrs(28) = ptrs(28) + 1
                    Case 1029: DataOut(ptrs(29), 1) = Item: ptrs(29) = ptrs(29) + 1
                    Case 1030: DataOut(ptrs(30), 1) = Item: ptrs(30) = ptrs(30) + 1
                    Case 1031: DataOut(ptrs(31), 1) = Item: ptrs(31) = ptrs(31) + 1
                    
                End Select
            Next Item
        
        rngBeg.Resize(UBound(DataOut, 1), 1).Value = DataOut
        
End Sub

 

[HackSlash]

If I had to guess I would say try to modify the range end:

Set rngBeg = Range("A1")
Set rngEnd = Cells(Rows.Count, "A").End(xlUp)

Change the "A" in rngEnd to different values and see how it works. The best way to learn is to try! Science!

 

[Rubber Beaked Woodpecker]

If I had to guess I would say try to modify the range end:

Set rngBeg = Range("A1")
Set rngEnd = Cells(Rows.Count, "A").End(xlUp)

Change the "A" in rngEnd to different values and see how it works. The best way to learn is to try! Science!

I've already tried that and another 100 things. No luck

 

[Rubber Beaked Woodpecker]

I'm still trying to sort this.

Here are two screenshots.
The first shows how the data will look before i execute the macro.
The second shows how how the sheet/data should be sorted after the macro is executed.

 

[HackSlash]

So you modified the "DataIn"

Looks like you also need to modify the "DataOut" to match.

The first part of the resize finds the upper bound of the row number. The second part of the resize is hard-set to 1. Remove this second part.

This:

rngBeg.Resize(UBound(DataOut, 1), 1).Value = DataOut

Becomes This:

rngBeg.Resize(UBound(DataOut, 1)).Value = DataOut

Now when you stretch your DataIn variable to fit all the columns the DataOut will match. I hope that works for you.

The code is very odd. It's not clear to me why anyone would ever make a 2D array and make the second dimension equal to one. It's not really a 2D array when you do that. It's just wasteful. Maybe the second dimension was used for something in an earlier version of this code.