PDA

View Full Version : [SOLVED:] Add a sort filter to existing code



rey06
02-17-2016, 10:39 AM
I have the below code which splits out a large file on the "flat file" sheet by vendor name (column Z). Wondering how I could add a code to sort column "AR" by values A-Z before it is split out. Hoping it's an easy fix! :)



Sub SplitByDistributor()
Workbooks(1).Activate
Dim lastCol As Integer, LastRow As Long, x As Long
Dim rng As Range, Rng1 As Range, Rng2 As Range, Rng3 As Range
Dim SheetNameArray, fn As WorksheetFunction
Dim CalcSetting As Integer
Dim newsht As Worksheet
Set fn = Application.WorksheetFunction

With Application
CalcSetting = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With Sheets("Flat File")
Set rng = .UsedRange
Set Rng1 = Intersect(rng, .Range("Z:Z"))
lastCol = rng.Column + rng.Columns.Count - 1

.Range("Z:Z").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=.Cells(1, lastCol + 2), Unique:=True

Set Rng2 = Intersect(.Columns(lastCol + 2).CurrentRegion, _
.Rows("2:" & Rows.Count))

ReDim SheetNameArray(1 To Rng2.Cells.Count)
SheetNameArray = fn.Transpose(Rng2)
.Columns(lastCol + 2).Clear

For x = LBound(SheetNameArray) To UBound(SheetNameArray)
On Error Resume Next
Set newsht = ThisWorkbook.Sheets(CStr(SheetNameArray(x)))
If Err <> 0 Then
Worksheets.Add
ActiveSheet.Name = CStr(SheetNameArray(x))
Err.Clear
End If
On Error GoTo 0
rng.AutoFilter Field:=26, Criteria1:=SheetNameArray(x)
Set Rng3 = Intersect(rng, .Cells.SpecialCells(xlCellTypeVisible))
Rng3.Copy Workbooks(1).Sheets(CStr(SheetNameArray(x))).Range("A1")
rng.AutoFilter
Next x
End With
Range("A1").Select
Application.Calculation = CalcSetting
Sheets(Array("MACROS", "Flat File")).Select
Sheets("Flat File").Activate
Sheets(Array("MACROS", "Flat File")).Move Before:=Sheets(1)
Sheets("MACROS").Select

End Sub

rey06
02-17-2016, 02:07 PM
I figured this one out altering the first range in the code from Z:Z to AR:AR did the trick.