I need some help with a sorting procedure

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,352
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I have code that transfers rows from a excel table to a specific worksheet in a specific workbook. The workbooks are for financial years and are named for instance, "2018 - 2019 NPSS Work Allocation Sheet" for the financial year of July 1 2018 - June 30 2019. I have code that transfers to the correct sheet and workbook. The sheets are all named July-June and have 36 columns but once it gets to the correct monthly sheet, I need the entries to sort by date order.

At the moment it just takes the rows from the table in my data entry tool and pastes them into the correct sheets but in the order that they are entered in the table and they may not be entered in chronological order. I therefore need the monthly sheets to be sorted by date order, earliest date to the latest. Each date is in column A and starts under all the headings in the monthly sheets in row 4. All monthly sheets are the same.

Here is my sort code that gave me an error of type mismatch


Code:
Sub cmdSort()
    Dim tblrow As ListRow
    Dim Combo As String
    Dim tbl As ListObject
    Dim sht As Worksheet
    Dim DocYearName As String
    Dim wsDst As Worksheet
    
        Set sht = Workbooks(DocYearName).Worksheets("Home")
    
            With sht
        
                Set tbl = .ListObjects("tblCosting")
                
                For Each tblrow In tbl.ListRows
                    Combo = tblrow.Range.Cells(1, 23).Value
                    DocYearName = tblrow.Range.Cells(1, 36).Value
                    
                    Set wsDst = Workbooks(DocYearName).Worksheets(Combo)
                    
                    'Sorting procedure
                        With wsDst
                            .Sort.SortFields.Clear
                            .Sort.SortFields.Add Key:=Range("A4:A1000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                            With Worksheets(Combo).Sort
                                .SetRange Range("A3:D1000")
                                .Header = xlYes
                                .MatchCase = False
                                .Orientation = xlTopToBottom
                                .SortMethod = xlPinYin
                                .Apply
                            End With
                        
                        End With
                    
                    
                        Next tblrow
                        End With

End Sub

In case you need it, here is my copy code that works

Code:
Sub cmdCopy()

Dim wsDst As Worksheet
Dim wsSrc As Worksheet
Dim tblrow As ListRow
Dim Combo As String
Dim sht As Worksheet
Dim tbl As ListObject
Dim lastrow As Long
Dim DocYearName As String



    Application.ScreenUpdating = False
    
    'assign values to variables
    Set sht = Worksheets("Home")
    
    With sht

        Set tbl = .ListObjects("tblCosting")
        
        
        
        For Each tblrow In tbl.ListRows
            Combo = tblrow.Range.Cells(1, 23).Value
            lastrow = Worksheets(Combo).Cells(Rows.Count, "A").End(xlUp).Row + 1                                    'number of first empty row in column A of Combo
            DocYearName = tblrow.Range.Cells(1, 36).Value
            
            Set wsDst = Workbooks(DocYearName).Worksheets(Combo)
          
                With wsDst
                    'This copies the first 10 columns, i.e. A:J, of the current row of the table to column A in the destination sheet.
                    tblrow.Range.Resize(, 10).copy
                    .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
                    'This should go to the 15th column in the current row, i.e. column O, and copy that column and the next 2 columns, i.e. O:Q, to column K on the destination sheet.
                    tblrow.Range.Offset(, 14).Resize(, 3).copy
                    .Range("K" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
                    'Similarly this should copy columns AD:AF from the table to column N on the destination sheet.
                    tblrow.Range.Offset(, 29).Resize(, 3).copy
                    .Range("N" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
                    
                End With
            
            
        Next tblrow
        
        Call SortDates
        
    End With
    
    Application.CutCopyMode = False

    Application.ScreenUpdating = True
    
End Sub

Thanks,
Dave
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
G'day Dave


  1. Is/are the data you're copying from the Excel Table to a specific worksheet in a specific workbook transactional in nature (i.e. tranx date, amount, acct code, etc.)?
  2. Is the data in the Excel Table all the same (i.e. just one big table of transactional data)?
  3. If so, can you not sort the data in the table by date before copying it to the other worksheets so you only need to do that once and it would be in the required order when it lands in the month sheet?

Re your sort code:

  1. I notice the sub is named cmdSort yet your cmdCopy sub calls the sub named SortDates. Is this correct?
  2. In cmdSort:
    1. What line is the debugger taking you to when the sub errors, and what exactly is the error reported?
    2. Code:
      Set sht = Workbooks(DocYearName).Worksheets("Home")
      appears to be executed before the variable DocYearName is initialized with a value.
    3. I notice your code refers to "static" ranges like Range("A4:A1000") and Range("A3:D1000"), when it may be better & more flexible if you used Defined Names (use the same name on each sheet and define them with the scope of the host sheet rather than with Workbook scope) and then assign those to variables in your code.
 
Upvote 0

Forum statistics

Threads
1,215,327
Messages
6,124,281
Members
449,149
Latest member
mwdbActuary

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top