Help with Macro (now to sort by dates)

 
Sub HANSKEEBELLAH()
If Selection.Columns.Count > 1 Then GoTo noGo
If GetColumn(Selection.Column) <> "KZ" Then GoTo noGo

Dim xRow    As Long
Dim strtRow As Long
Dim lstRow  As Long
Dim myArray()
Dim xCol    As Long
Dim sCol    As Long
Dim eCol    As Long
Dim x       As Long
Dim y       As Long
Dim current As Worksheet
Dim wsT     As Worksheet

strtRow = Selection.Rows(1).Row
lstRow = Selection.Rows(Selection.Rows.Count).Row

Set current = Sheets(ActiveSheet.Name)

Select Case MsgBox("Selection:" & vbNewLine & _
    Chr(9) & "# of rows selected" & Chr(9) & ": " & (lstRow - strtRow) + 1 & vbNewLine & _
    Chr(9) & "range to sort" & Chr(9) & ": 'LB" & strtRow & ":MT" & lstRow & "'" & vbNewLine & vbNewLine & _
    "Press 'OK' to continue", vbInformation + vbOKCancel, "")
Case Is <> vbOK: Exit Sub
End Select

Application.ScreenUpdating = False
ActiveWorkbook.Worksheets.Add Before:=current           ' create a temporary worksheet
ActiveSheet.Name = "TEMP"
Set wsT = Sheets("TEMP")
Application.ScreenUpdating = True
current.Activate

For xRow = strtRow To lstRow
    If Len(Trim(Cells(xRow, "KZ").Value)) > 0 And Len(Trim(Cells(xRow, "LA").Value)) > 0 And _
        IsNumeric(Cells(xRow, "LA").Value) And Cells(xRow, "LA").Value > 0 And Len(Trim(Cells(xRow, "LB").Value)) > 0 Then
        Application.StatusBar = "Processing " & xRow & " row " & (xRow - strtRow) + 1 & " of " & (lstRow - strtRow) + 1
        x = 0
        wsT.Cells.Clear
        sCol = Cells(xRow, "KZ").Offset(0, 2).Column
        For xCol = sCol To sCol + 42 Step 3                 ' transpose the 5 column groups to the temporary worksheet
            x = x + 1
            With wsT
                .Cells(x, 1).Value = Cells(xRow, GetColumn(xCol)).Value
                .Cells(x, 2).Value = Cells(xRow, GetColumn(xCol + 1)).Value
                .Cells(x, 3).Value = Cells(xRow, GetColumn(xCol + 2)).Value
                .Cells(x, 4).Value = xRow
                .Cells(x, 5).Value = InteriorColor(Cells(xRow, GetColumn(xCol)))
            End With
        Next xCol
        
        wsT.Sort.SortFields.Clear                           ' sort on column A with is the numeric value
        wsT.Sort.SortFields.Add Key:=Range("A1:A5"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With wsT.Sort
            .SetRange Range("A1:C15")
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        
        x = 0
        For xCol = sCol To sCol + 42 Step 3                 ' transpose the sorted rows from the temporary sheet overwriting the original values
            x = x + 1
            Cells(xRow, GetColumn(xCol)).Value = wsT.Cells(x, 1).Value
            Cells(xRow, GetColumn(xCol + 1)).Value = wsT.Cells(x, 2).Value
            Cells(xRow, GetColumn(xCol + 2)).Value = wsT.Cells(x, 3).Value
            Range(GetColumn(xCol) & xRow & ":" & GetColumn(xCol + 2) & xRow).Interior.Color = wsT.Cells(x, 5).Value
        Next xCol
    End If
Next xRow

Application.StatusBar = False
Application.DisplayAlerts = False
wsT.Delete                                                      ' delete the temporary sheet
Application.DisplayAlerts = True
Cells(strtRow, "KZ").Select
Exit Sub

noGo:
MsgBox "Incorrect column(s) selected!", vbExclamation, ""

End Sub

This sorts the data by using the 1st cell,4th cell,etc to the end of the row.
now I wish it to sort by the 3rd cell,6th cell etc
see excel sheet
Thanks
Steve.

Sort by date

Hi, pennbowl,

Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

Posting code between [CODE] [/CODE] tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here

And maybe you should change the title of the thread to a better fitting.


(This thread should receive no further responses until this moderation request is fulfilled, as per Forum Rule 7)

Ciao,
Holger