Sorting key

[dpaton05]

When you are sorting using range.sort method, one of the parameters is Key. If I want to sort by column A, with the header being in row 3 and the data to sort starting in row 4. What would the key be, is it A3?

 

[dpaton05]

This is what the table looks like that I am going to copy from.

CSS quoting tool 29.45.xlsm
	A	B	C	D	E	F	G			J	K	L
4	Date	Purchase order #	Quote Ref #	Name	Service	Requesting Organisation	worker Name			Price ex. GST	GST	Price inc. GST
5	05/08/2020		10555		Transport	My organisation				$55.80	$5.58	$61.38
6	04/08/2020		10556		Transport	My organisation				$55.80	$5.58	$61.38
7	05/08/2021		10558		Transport	My organisation				$56.00	$5.60	$61.60
8	04/08/2021		10556		Transport	My organisation				$31.00	$3.10	$34.10
Costing_tool

Cell Formulas
Range	Formula
K5:K8	K5	=IF(E5="Activities",0,[Price ex. GST]*0.1)
L5:L8	L5	=IF(E5="Activities",[@[Price ex. GST]],[GST]+[Price ex. GST])

The entries are from different finacial years so they will go to different files. Here is the result of the copy to the 2020-2021 files

2020 - 2021 Western CSS Work Allocation Sheet.xlsm
	A	B	C	D	E	F	G	H	I	J
3	Date	Purchase order #	Req #	Name	Service	Requesting Organisation	worker Name	Price ex. GST	GST	Price inc. GST
4	05/08/2020		10555		Transport	My organisation		$55.80	$5.58	$61.38
5	04/08/2020		10556		Transport	My organisation		$55.80	$5.58	$61.38
August

Cell Formulas
Range	Formula
I4:I5	I4	=IF(E4="Activities",0,H4*0.1)
J4:J5	J4	=I4+H4

Notice how they haven't been sorted in the above table

2021 - 2022 Western Report Tracking.xlsm
	A	B	C	D	E	F	G	H	I
1	Date	Name	Service	Allocated to	Date report received	Date report sent	Allocated by	Report sent by	Report sent by
2	05/08/2021		Transport
3	44412		Transport
August

No idea what has happened with the date of the second entry in this file.




And here is the result of the copy to the 2021-2022 files

2021 - 2022 Western CSS Work Allocation Sheet.xlsm
	A	B	C	D	E	F	G	H	I	J
3	Date	Purchase order #	Req #	Name	Service	Requesting Organisation	worker Name	Price ex. GST	GST	Price inc. GST
4	04/08/2021		10556		Transport	My organisation		$31.00	$3.10	$34.10
5	05/08/2021		10558		Transport	My organisation		$56.00	$5.60	$61.60
August

Cell Formulas
Range	Formula
I4:I5	I4	=IF(E4="Activities",0,H4*0.1)
J4:J5	J4	=I4+H4

The above table did sort the entries, where it didn't sort the previous table. I think this is as the sort code referred to wsDst and the second year was the last time the variable was used, so it sorted that sheet?

2021 - 2022 Western Report Tracking.xlsm
	A	B	C	D	E	F	G	H	I
1	Date	Name	Service	Allocated to	Date report received	Date report sent	Allocated by	Report sent by	Report sent by
2	05/08/2021		Transport
3	44412		Transport
August

Again, I do not know what happened to the date.


I did think of a possible solution. Everytime a new instance of wsDst is opened, add the name to an array and then do a sort on each item in the array at the end?

 

[dpaton05]

I have been trying to work out how I can use an array to find the financial year document of each row and store it if it is not already there. Therefore, there will be no duplicates.

I then wanted to do a single sort on each filename in the array at the end of the procedure but I am having great trouble with the code.

Can someone help me please?

 

[dpaton05]

Nevermind about the previous question. I just want to get my spreadsheets to sort.

This is my code but it is not sorting on each output sheet.

Sub cmdCopy()
    Dim wsDst As Worksheet, wsHours As Worksheet, wsTrack As Worksheet, worker As String, wsSrc As Worksheet, tblrow As ListRow
    Dim Combo As String, sht As Worksheet, tbl As ListObject, wsDstDates As Variant, wsDstFilenames As Long, tblCostingArray As Variant
    Dim lastrow As Long, DocYearName As String, Site As String, lr As Long, HoursRow As Long, lrTrack As Long, lRow As Long
    Dim RowColor As Long, w As Window, r As Long, HoursRegister As String, ReportTracking As String, i As Long
        Application.ScreenUpdating = False
          

    
       
    'assign values to variables
    Set tbl = ThisWorkbook.Worksheets("Costing_tool").ListObjects("tblCosting")
    Set sht = ThisWorkbook.Worksheets("Costing_tool")
    tblCostingArray = sht.ListObjects("tblCosting").DataBodyRange.Value
    Site = ThisWorkbook.Worksheets("Start_here").Range("H9").Value
    
lRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row

                    
    ReDim wsDstDates(1 To lRow) As Long
    
    For i = 5 To UBound(tblCostingArray, 1)
        'I started to try and write this but I got lost. I just want my spreadsheets to sort now
    Next i
    
    
    
    
    'Check if each row has a date, service and requesting organisation
    For Each tblrow In tbl.ListRows
        If tblrow.Range.Cells(1, 1).Value = "" Or tblrow.Range.Cells(1, 5).Value = "" Or tblrow.Range.Cells(1, 6).Value = "" Then
            MsgBox "The Date, Service or Requesting Organisation has not been entered for every record in the table"
            Exit Sub
        End If
    Next tblrow
    For Each tblrow In tbl.ListRows
        'Define combo as the month to be recorded in
        Combo = tblrow.Range.Cells(1, 26).Value
        'If column 8 for the row is blank...
        If Not tblrow.Range(1, 8).Value = "" Then
            'worker variable is defined as the value in column 8 of the row
            worker = tblrow.Range.Cells(1, 8).Value
        Else
            'otherwise, "not allocated" is assigned to the worker variable.
            'this is used in the hours register to identify which sheet to place the hours in
            worker = "Not allocated"
        End If
        'defines HoursRegister as the hours register filename that is stored in column 38 for the row
        HoursRegister = tblrow.Range.Cells(1, 38)
        'defines ReportTracking as the report tracking filename that is stored in column 39 for the row
        ReportTracking = tblrow.Range.Cells(1, 39)
            Select Case Site
                Case "W"
                    Select Case tblrow.Range.Cells(1, 6).Value
                        Case "AW", "AWA", "AA", "ASC", "Y"
                            DocYearName = tblrow.Range.Cells(1, 37).Value
                        Case Else
                            DocYearName = tblrow.Range.Cells(1, 36).Value
                    End Select
                Case "R"
                    Select Case tblrow.Range.Cells(1, 6).Value
                        Case "AW", "AWA", "AA", "ASC", "Y"
                            DocYearName = tblrow.Range.Cells(1, 42).Value
                        Case Else
                            DocYearName = tblrow.Range.Cells(1, 36).Value
                    End Select
                    
                    
                    
                'Case "AWA", "AA"
                 '   DocYearName = tblrow.Range.Cells(1, 42).Value
                'Case "AA"
                 '   DocYearName = tblrow.Range.Cells(1, 41).Value
                'Case "AW", "Y"
                '    DocYearName = tblrow.Range.Cells(1, 37).Value
                'Case Else
                '    DocYearName = tblrow.Range.Cells(1, 36).Value
            End Select
        If Not isFileOpen(DocYearName & ".xlsm") Then Workbooks.Open ThisWorkbook.Path & "\" & "Work Allocation Sheets" & "\" & Site & "\" & DocYearName & ".xlsm"
        'If Not isFileOpen(HoursRegister & ".xlsm") Then Workbooks.Open ThisWorkbook.Path & "\" & "Hours Register" & "\" & Site & "\" & HoursRegister & ".xlsm"
        If Not isFileOpen(ReportTracking & ".xlsm") Then Workbooks.Open ThisWorkbook.Path & "\" & "Report Tracking" & "\" & Site & "\" & ReportTracking & ".xlsm"
        'Set wsHours = Workbooks(HoursRegister).Worksheets(worker)
        Set wsDst = Workbooks(DocYearName).Worksheets(Combo)
        Set wsTrack = Workbooks(ReportTracking).Worksheets(Combo)
        lr = wsDst.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
        lrTrack = wsTrack.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
        'With wsHours
              'this copies the date column in the tblCosting
            'HoursRow = .Range("A" & Rows.Count).End(xlUp).Row
            'tblrow.Range(, 1).Copy
            'this pastes it into column A of hours register file
            '.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
              'this copies the YP name column in the tblCosting
            'tblrow.Range(, 4).Copy
            'this pastes it into column B of hours register file
            '.Range("B" & HoursRow).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
               'this copies the YP name column in the tblCosting
            'tblrow.Range(, 3).Copy
            'this pastes it into column A of hours register file
            '.Range("C" & HoursRow).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
               'this copies the hours column in the tblCosting
            'tblrow.Range(, 9).Copy
            'this pastes it into column A of hours register file
            '.Range("D" & HoursRow).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
        'End With
        With wsTrack
            'this copies the date column in the tblCosting
            tblrow.Range(, 1).Copy
            'this pastes it into column A of report tracking file
            .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
              'this copies the YP name column in the tblCosting
            tblrow.Range(, 4).Copy
            'this pastes it into column B of report tracking file
            .Range("A" & Rows.Count).End(xlUp).Offset(, 1).PasteSpecial xlPasteValues
               'this copies the YP name column in the tblCosting
            tblrow.Range(, 5).Copy
            'this pastes it into column A of report tracking file
            .Range("A" & Rows.Count).End(xlUp).Offset(, 2).PasteSpecial xlPasteValues

            
            With .Sort
                With .SortFields
                    .Clear
                    .Add Key:=wsTrack.Range("A1"), _
                        SortOn:=xlSortOnValues, _
                        Order:=xlAscending, _
                        DataOption:=xlSortNormal
                End With
                'set range to sort of A1 to I
                .SetRange wsTrack.Range("A1:I" & lrTrack)
                .header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With



        End With
        With wsDst
                'This sets column width of request number column so it can be read and is not xxxxx
                .Columns("C:C").ColumnWidth = 8
                'This copies the first 7 columns, i.e. A:G, of the current row of the table to column A in the destination sheet.
                tblrow.Range.Resize(, 7).Copy
                'This pastes in the figures in the first 7 columns starting in column A
                .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
                'This copies the first 7 columns, i.e. A:G, of the current row of the table to column A in the destination sheet.
                tblrow.Range(, 10).Copy
                'This pastes in the figures in the first 7 columns starting in column A
                .Range("H" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
                
                'Overwrites the numbers pasted to column I with a formula
                .Range("I" & Rows.Count).End(xlUp).Offset(1).Formula = "=IF(RC[-4]=""Activities"",0,RC[-1]*0.1)"
                'Overwrites the numbers pasted to column L with a formula
                .Range("J" & Rows.Count).End(xlUp).Offset(1).Formula = "=RC[-1]+RC[-2]"
                'Adds currency formatting to total ex gst column
                .Columns(8).NumberFormat = "$#,##0.00"
                'Adds Australian date format to date column
                '.Range("A:A").NumberFormat = "dd/mm/yyyy"

            With .Sort
                With .SortFields
                    .Clear
                    .Add Key:=wsDst.Range("A3"), _
                        SortOn:=xlSortOnValues, _
                        Order:=xlAscending, _
                        DataOption:=xlSortNormal
                End With
                'set range to sort of A3 to AO
                .SetRange wsDst.Range("A3:AO" & lr)
                .header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
            
            
        End With
    Next tblrow
        'lr = wsDst.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

I also found a little function but I do not know how to use it

Private Function IsInArray(valToBeFound As Variant, arr As Variant) As Boolean

'How to use: bBool = IsInArray("hello", arr)
Dim element As Variant
On Error GoTo IsInArrayError: 'array is empty
    For Each element In arr
        If element = valToBeFound Then
            IsInArray = True
            Exit Function
        End If
    Next element
Exit Function
IsInArrayError:
On Error GoTo 0
IsInArray = False
End Function

 

[dpaton05]

Can I get some help to sort my output spreadsheets please?

 

[dpaton05]

I do not know a great deal of vba and can't work out all by myself why this won't sort. I need help from more experienced programmers.

Can someone please help me?

 

[Michael M]

Can you upload the current workbook ??
I may not be able to help at the moment, but I might see something in the code when it runs
AND which button triggers the macro ?

 

[dpaton05]

Here is a zip file of the workbook and the additional workbooks that are needed when the procedure is executed. They are in the correct file structure for it all to work. The procedure is in the quoting tool file. The procedure called cmdCopy, and it is in module 5.

To see what I see, open the costing_tool sheet and click on the red button 2 or 3 times. It will copy the rows to the relevant sheets and the August sheet in the allocation and the report tracking files will be sorted as that sheet is the most recent version of wsDst and wsTrack in the code but the July sheet in both files is not sorted.

There could be any number of wsDst sheets that are opened with data copied to it/them.

Here is a link to download it

to upload.zip

Shared with Dropbox

www.dropbox.com

Thanks for helping Michael.

 

[Michael M]

Hey Dave
where are these files ???

        If Not isFileOpen(DocYearName & ".xlsm") Then Workbooks.Open ThisWorkbook.Path & "\" & "Work Allocation Sheets" & "\" & Site & "\" & DocYearName & ".xlsm"

 

[dpaton05]

What do you mean, where are they? Do you need copies of them?

If you look at the zip file, they are in the work allocation sheet folder, in the w or r folder.

 

[dpaton05]

I had some code that worked a few versions back to sort wsDst so I decided I would try that, even though the code is a bit slower. Since wsDst was sorted correctly, I tried to copy it and adjust it for wsTrack, but it wouldn't sort my report tracking sheet as it would sort the wsDst sheet.

Sub cmdCopy()
Dim wsDst As Worksheet, wsHours As Worksheet, wsTrack As Worksheet, worker As String, wsSrc As Worksheet, tblrow As ListRow

Dim Combo As String, sht As Worksheet, tbl As ListObject

Dim lastrow As Long, DocYearName As String, Site As String, lr As Long, HoursRow As Long, lrTrack As Long

Dim RowColor As Long, w As Window, r As Long, HoursRegister As String, ReportTracking As String

Application.ScreenUpdating = False



'assign values to variables

Set tbl = ThisWorkbook.Worksheets("Costing_tool").ListObjects("tblCosting")

Set sht = ThisWorkbook.Worksheets("Costing_tool")

Site = ThisWorkbook.Worksheets("Start_here").Range("H9").Value

'Check if each row has a date, service and requesting organisation

For Each tblrow In tbl.ListRows

If tblrow.Range.Cells(1, 1).Value = "" Or tblrow.Range.Cells(1, 5).Value = "" Or tblrow.Range.Cells(1, 6).Value = "" Then

MsgBox "The Date, Service or Requesting Organisation has not been entered for every record in the table"

Exit Sub

End If

Next tblrow

For Each tblrow In tbl.ListRows

'Define combo as the month to be recorded in

Combo = tblrow.Range.Cells(1, 26).Value

'If column 8 for the row is blank...

If Not tblrow.Range(1, 8).Value = "" Then

'worker variable is defined as the value in column 8 of the row

worker = tblrow.Range.Cells(1, 8).Value

Else

'otherwise, "not allocated" is assigned to the worker variable.

'this is used in the hours register to identify which sheet to place the hours in

worker = "Not allocated"

End If

'defines HoursRegister as the hours register filename that is stored in column 38 for the row

HoursRegister = tblrow.Range.Cells(1, 38)

'defines ReportTracking as the report tracking filename that is stored in column 39 for the row

ReportTracking = tblrow.Range.Cells(1, 39)

Select Case Site

Case "W"

Select Case tblrow.Range.Cells(1, 6).Value

Case "Life Without Barriers", "Lifestyle Solutions", "Live Better", "Other", "Veritas House"

DocYearName = tblrow.Range.Cells(1, 37).Value

Case Else

DocYearName = tblrow.Range.Cells(1, 36).Value

End Select

Case "R"

Select Case tblrow.Range.Cells(1, 6).Value

Case "Life Without Barriers", "Lifestyle Solutions", "Live Better", "Other", "Veritas House"

DocYearName = tblrow.Range.Cells(1, 42).Value

Case Else

DocYearName = tblrow.Range.Cells(1, 36).Value

End Select


End Select

If Not isFileOpen(DocYearName & ".xlsm") Then Workbooks.Open ThisWorkbook.Path & "\" & "Work Allocation Sheets" & "\" & Site & "\" & DocYearName & ".xlsm"

'If Not isFileOpen(HoursRegister & ".xlsm") Then Workbooks.Open ThisWorkbook.Path & "\" & "Hours Register" & "\" & Site & "\" & HoursRegister & ".xlsm"

If Not isFileOpen(ReportTracking & ".xlsm") Then Workbooks.Open ThisWorkbook.Path & "\" & "Report Tracking" & "\" & Site & "\" & ReportTracking & ".xlsm"

'Set wsHours = Workbooks(HoursRegister).Worksheets(worker)

Set wsDst = Workbooks(DocYearName).Worksheets(Combo)

Set wsTrack = Workbooks(ReportTracking).Worksheets(Combo)

lr = wsDst.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row

lrTrack = wsTrack.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row

'With wsHours

'this copies the date column in the tblCosting

'HoursRow = .Range("A" & Rows.Count).End(xlUp).Row

'tblrow.Range(, 1).Copy

'this pastes it into column A of hours register file

'.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats

'this copies the YP name column in the tblCosting

'tblrow.Range(, 4).Copy

'this pastes it into column B of hours register file

'.Range("B" & HoursRow).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats

'this copies the YP name column in the tblCosting

'tblrow.Range(, 3).Copy

'this pastes it into column A of hours register file

'.Range("C" & HoursRow).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats

'this copies the hours column in the tblCosting

'tblrow.Range(, 9).Copy

'this pastes it into column A of hours register file

'.Range("D" & HoursRow).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
'End With With wsTrack

'this copies the date column in the tblCosting
tblrow.Range(, 1).Copy
'this pastes it into column A of report tracking file
.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
'this copies the YP name column in the tblCosting
tblrow.Range(, 4).Copy
'this pastes it into column B of report tracking file
.Range("A" & Rows.Count).End(xlUp).Offset(, 1).PasteSpecial xlPasteValues
'this copies the YP name column in the tblCosting
tblrow.Range(, 5).Copy
'this pastes it into column A of report tracking file
.Range("A" & Rows.Count).End(xlUp).Offset(, 2).PasteSpecial xlPasteValues

lrTrack = wsTrack.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
wsTrack.Sort.SortFields.Clear
wsTrack.Sort.SortFields.Add Key:=Range("A2:I" & lrTrack), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Workbooks(ReportTracking).Worksheets(Combo).Sort
'set range to sort of A3 to AO
.SetRange Range("A1:I" & lrTrack)
.header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

End With
With wsDst
'This sets column width of request number column so it can be read and is not xxxxx
.Columns("C:C").ColumnWidth = 8
'This copies the first 7 columns, i.e. A:G, of the current row of the table to column A in the destination sheet.
tblrow.Range.Resize(, 7).Copy
'This pastes in the figures in the first 7 columns starting in column A
.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
'This copies the first 7 columns, i.e. A:G, of the current row of the table to column A in the destination sheet.
tblrow.Range(, 10).Copy
'This pastes in the figures in the first 7 columns starting in column A
.Range("H" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues

'Overwrites the numbers pasted to column I with a formula
.Range("I" & Rows.Count).End(xlUp).Offset(1).Formula = "=IF(RC[-4]=""Activities"",0,RC[-1]*0.1)"
'Overwrites the numbers pasted to column L with a formula
.Range("J" & Rows.Count).End(xlUp).Offset(1).Formula = "=RC[-1]+RC[-2]"
'Adds currency formatting to total ex gst column
.Columns(8).NumberFormat = "$#,##0.00"
'Adds Australian date format to date column
'.Range("A:A").NumberFormat = "dd/mm/yyyy"

lr = wsDst.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
wsDst.Sort.SortFields.Clear
wsDst.Sort.SortFields.Add Key:=Range("A4:A" & lr), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Workbooks(DocYearName).Worksheets(Combo).Sort
'set range to sort of A3 to AO
.SetRange Range("A3:AO" & lr)
.header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

End With
Next tblrow

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

The code worked to sort each instance of wsDst before I added the following code

lrTrack = wsTrack.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
wsTrack.Sort.SortFields.Clear
wsTrack.Sort.SortFields.Add Key:=Range("A2:I" & lrTrack), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Workbooks(ReportTracking).Worksheets(Combo).Sort
'set range to sort of A3 to AO
.SetRange Range("A1:I" & lrTrack)
.header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

When it was added, I got the error "The sort reference is not valid. Make sure that it's within the data you want to sort, and the first sort by box isn't the same or blank". The error appears when the code gets to .apply. Have I done something wrong?