VBA sorting

[andy_2610]

Hi all,

I have some code and basically what it does is sorting by sales rep and copying the row and pasting it into another worksheet that is created if that sales rep does not exist in the same workbook. But if the sales rep does exist it will paste into that worksheet.

Now after each sales rep is pasted into each of their worksheet, I want it to sort by the "inv_date" in Column F by oldest to newest.

Here is my code:

Sub AddSheets()
Application.ScreenUpdating = False
Dim LastRow As Long
LastRow = Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim c As Range
Dim rng As Range
Dim ws As Worksheet
Dim response As String
'Above text - declaring variables
For Each c In Range("A2:A" & LastRow)
Set ws = Nothing
On Error Resume Next
Set ws = Worksheets(c.Value)
On Error GoTo 0
If ws Is Nothing Then
Worksheets.Add(After:=Sheets(Sheets.Count)).Name = c.Value
Sheets("Sheet1").Rows(1).EntireRow.Copy ActiveSheet.Range("A1")
End If
Next c
For Each ws In Sheets
If ws.Name <> "Sheet1" Then
Sheets(ws.Name).UsedRange.Offset(1, 0).ClearContents
End If
Next ws
For Each rng In Sheets("Sheet1").Range("A2:A" & LastRow)
For Each ws In Sheets
If rng = ws.Name And Year(rng.Offset(0, 3)) = Year(Date) Then
'If rng = ws.Name And Year(rng.Offset(0, 3)) = response Then
rng.EntireRow.Copy Sheets(ws.Name).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
Next ws
Next rng
Application.ScreenUpdating = True
End Sub


If you need more clarification. Please ask.

Thanks in advance,

Andrew

 

[andy_2610]

For some reason the code is not tabbed over like how I have it in VBA. I apologize.

 

[Perpa]

For some reason the code is not tabbed over like how I have it in VBA. I apologize.

andy_2610,
Try the following code to '... sort by the "inv_date" in Column F by oldest to newest.'
Place the new code just above your existing line 'Application.ScreenUpdating = True'.
Please test on a copy of your workbook. Successful sorting!
Perpa

For Each ws In Sheets
     If ws = Sheets("Sheet1") goto 100		'Skips Sheet1
    'Sorts in 'Decending Order'
    Dim LR As Long, LC As Long
    
    LR = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
    LC = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
    Range(Cells(2, 1), Cells(LR, LC)).Select
    ActiveWorkbook.Worksheets(ws).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(ws).Sort.SortFields.Add Key:=Range(Cells(2, 6), Cells(LR, 6)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(ws).Sort
        .SetRange Range(Cells(2, 1), Cells(LR, LC))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    Range("A1").Select    'This unselects the Used Range	
100:
Next ws