Sorting a table using vba code

[dpaton05]

I am trying to sort a table by the date column with this code:

    'declare variables
    Dim combo As String                                                     'Combo worksheet name
    
    'assign values to variables
    combo = Worksheets("Home").Range("Q5")                                  'string in cell Q5 of Home worksheet
    
    Range(combo).CurrentRegion.Sortkey1:=Range("Date of work"), order1:=xlAscending, Header:=xlYes

Combo has the relevant sheet name stored within it and the table goes up column Q. Can anyone tell me what I have done wrong with this code please as it gives me a syntax error and highlights the range(combo) line of code?

Thanks,
Dave

 

[dpaton05]

Use

Sub cmdSort()
'
   'Sorting procedure
'
    Dim Combo As String
        Combo = Worksheets("Home").Range("Q5")
    'Range("A3:D1920").Select
    With Worksheets(Combo)
        .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
Application.CutCopyMode = False

End Sub

I have a problem with this code now Michael. My supervisor now wants to be able to transfer multiple rows at once and to different documents relating to the financial year. I have the copy procedure correct but I am not sure how to correct my sort procedure.

Here is my copy procedure 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

....and here is my sort procedure code

Sub cmdSort()
    Dim tblrow As ListRow
    Dim Combo As String
Worksheets("home").Unprotect Password:="costings"
   'Sorting procedure


       [COLOR=#ff0000] Combo = tblrow.Range.Cells(1, 23).Value[/COLOR]
    With Worksheets(Combo)
        .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
Application.CutCopyMode = False
'Worksheets("home").Protect Password:="costings"

End Sub

I get the error message of object variable or with block variable not set and it highlights the highlighted row. What is wrong with my code? I think the problem may be that I copied the code to set combo from my copy code to my sort code?

Thanks Michael,
Dave

 

[Michael M]

You either want range OR Cells...not both
Try

Combo = Cells(1, 23).Value

 

[dpaton05]

But in my copy code I have this and it works.

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

 

[Michael M]

you haven't referred to your table in the sort code !!

Set tbl = .ListObjects("tblCosting")

 

[dpaton05]

Got another problem with this Michael.

The cmdSend code correctly sends the rows in the table to the correct monthly tab within the correct workbook. The rows store quotes and if they are not accepted, I want to move them to a Not accepted quotes sheet. I want the row to be selected and then code run that will move the individual row to a sheet called Not accepted quotes, within the workbook that the code in cmdSend has identified. The sheet will be alongside the other monthly sheets, January, February, March etc.


I am trying to learn how to do these things you have been helping me with so I copied some other code you wrote and tried to play around with it but it didn't work.

Could you tell me where I have gone wrong please?

Sub cmdNotAcceptCopy()
        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
        Dim rng As Range
        
        
        Application.ScreenUpdating = False
        'assign values to variables
        
        Set tbl = ThisWorkbook.Worksheets("Costing_tool").ListObjects("tblCosting")
        Combo = "Not accepted quotes"
        
        With Selection.Cells(1)
        Set rng = Intersect(.EntireRow, ActiveCell.ListObject.DataBodyRange)
        On Error GoTo 0
            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
                    
            If rng Is Nothing Then
                MsgBox "To move a quote to the unaccepted quotes section in the correct allocation sheet, first select the row by clicking on the number on the left hand side of the row.", vbCritical
            Else
                
            If tblrow.Range.Cells(1, 6).Value = "Anglicare Western" Then
                DocYearName = tblrow.Range.Cells(1, 37).Value
            Else
                DocYearName = tblrow.Range.Cells(1, 36).Value
            End If
            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(, 15).Copy
                    .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
                    'Sort rows based on date
                        Rows("3:1000").Select
                        Workbooks(DocYearName).Worksheets(Combo).Sort.SortFields.Clear
                        Workbooks(DocYearName).Worksheets(Combo).Sort.SortFields.Add Key:=Range("A4:A1000"), _
                            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                                With Workbooks(DocYearName).Worksheets(Combo).Sort
                                    .SetRange Range("A3:AJ1000")
                                    .header = xlYes
                                    .MatchCase = False
                                    .Orientation = xlTopToBottom
                                    .SortMethod = xlPinYin
                                    .Apply
                                End With
                End With
                
                
            End If
        
        End With
  
    
            'lastrow = Worksheets(Combo).Cells(Rows.Count, "A").End(xlUp).Row + 1                                    'number of first empty row in column A of Combo
                


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

Thanks Michael,
Dave