PDA

View Full Version : Solved: Filter Range Issue.



LutonBarry
05-23-2013, 01:47 PM
Hello I have a quick question related to my code below. I have highlighed in BOLD and underline the lines I am querying. This macro was in effect written mainly using the recorder.

Where AutoFilter selects a range it mentions it by cell references ("$A$1:$S106") for example. My problem is that next time it runs the data will have canged and the range could be smaller or indeed larger. How would I edit the code to take account of a different data range.

Sub NewClosedCalls()
'
' NewClosedCalls Macro
'

'
Dim myRange As Range

Sheets("All").Select
Cells.Select
Selection.Copy
Sheets("Closed").Select
Range("A1").Select
ActiveSheet.Paste
Rows("1:1").Select
Application.CutCopyMode = False
Selection.AutoFilter
Columns("B:B").Select
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriori ty
Selection.FormatConditions(1).DupeUnique = xlDuplicate
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("A2").Select
ActiveSheet.Range("$A$1:$S$356").AutoFilter Field:=2, Criteria1:=RGB(255, _
199, 206), Operator:=xlFilterCellColor
ActiveCell.CurrentRegion.Select
Set myRange = Range("A1").CurrentRegion
myRange.Select
myRange.Offset(1).Resize(myRange.Rows.Count - 1).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
ActiveSheet.Range("$A$1:$S$106").AutoFilter Field:=2
ActiveSheet.Range("$A$1:$S$106").AutoFilter Field:=1, Criteria1:="Today"
ActiveCell.CurrentRegion.Select
Set myRange = Range("A1").CurrentRegion
myRange.Select
myRange.Offset(1).Resize(myRange.Rows.Count - 1).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
ActiveSheet.Range("$A$1:$S$62").AutoFilter Field:=1
Cells.Select
Cells.EntireRow.AutoFit
Cells.EntireColumn.AutoFit
Range("A2").Select
Sheets("All").Select
Cells.Select
Selection.Copy
Sheets("New").Select
Range("A1").Select
ActiveSheet.Paste
Rows("1:1").Select
Application.CutCopyMode = False
Selection.AutoFilter
Columns("B:B").Select
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriori ty
Selection.FormatConditions(1).DupeUnique = xlDuplicate
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("A2").Select
ActiveSheet.Range("$A$1:$S$356").AutoFilter Field:=2, Criteria1:=RGB(255, _
199, 206), Operator:=xlFilterCellColor
ActiveCell.CurrentRegion.Select
Set myRange = Range("A1").CurrentRegion
myRange.Select
myRange.Offset(1).Resize(myRange.Rows.Count - 1).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
ActiveSheet.Range("$A$1:$S$106").AutoFilter Field:=2
ActiveSheet.Range("$A$1:$S$106").AutoFilter Field:=1, Criteria1:="Yesterday"
ActiveCell.CurrentRegion.Select
Set myRange = Range("A1").CurrentRegion
myRange.Select
myRange.Offset(1).Resize(myRange.Rows.Count - 1).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
ActiveSheet.Range("$A$1:$S$62").AutoFilter Field:=1
Cells.Select
Cells.EntireRow.AutoFit
Cells.EntireColumn.AutoFit
Range("A2").Select
End Sub

mancubus
05-24-2013, 12:37 AM
hi.

test the below procedure with a copy of your file...
i just reorganized the recorded code and deleted uncessary lines.



.Range("A1").CurrentRegion.Copy wsN.Range("A1")
same procedure. you dont need to repeat. just copy the rows to "new" after removing dupes in "closed."



Sub NewClosedCalls()
Dim wsC As Worksheet, wsN As Worksheet
Dim LastRow As Long

Application.DisplayAlerts = False

Set wsC = Worksheets("Closed")
Set wsN = Worksheets("New")

Worksheets("All").Range("A1").CurrentRegion.Copy wsC.Range("A1")

With wsC
LastRow = .Range("B" & Rows.Count).End(xlUp).Row
With .Range("B1:B" & LastRow)
.FormatConditions.AddUniqueValues
.FormatConditions(1).DupeUnique = xlDuplicate
.FormatConditions(1).Font.Color = -16383844
.FormatConditions(1).Interior.Color = 13551615
End With
.AutoFilterMode = False
.Range("A1").CurrentRegion.AutoFilter Field:=2, _
Criteria1:=RGB(255, 199, 206), Operator:=xlFilterCellColor
With .AutoFilter.Range.Offset(1, 0).Resize(.Rows.Count - 1)
If Not .SpecialCells(xlCellTypeVisible) Is Nothing Then
.Rows.Delete
End If
End With
.AutoFilterMode = False
.Range("A1").CurrentRegion.Copy wsN.Range("A1")
.Range("A1").CurrentRegion.AutoFilter Field:=1, Criteria1:="Today"
With .AutoFilter.Range.Offset(1, 0).Resize(.Rows.Count - 1)
If Not .SpecialCells(xlCellTypeVisible) Is Nothing Then
.Rows.Delete
End If
End With
.AutoFilterMode = False
.Rows.AutoFit
.Columns.AutoFit
End With

With wsN
.AutoFilterMode = False
.Range("A1").CurrentRegion.AutoFilter Field:=1, Criteria1:="Yesterday"
With .AutoFilter.Range.Offset(1, 0).Resize(.Rows.Count - 1)
If Not .SpecialCells(xlCellTypeVisible) Is Nothing Then
.Rows.Delete
End If
End With
.AutoFilterMode = False
.Rows.AutoFit
.Columns.AutoFit
End With
End Sub

LutonBarry
05-24-2013, 04:16 AM
Mancubus, I'm always amazed at others ability. copied your code straight in and worked straight off. So thanks so much for your help here and indeed the quick reply. the shorter code certainly speeds things up to.

So thanks again and this will go down as a further learning.
Regs,

Barry:bow::bow::bow:

mancubus
05-24-2013, 05:04 AM
you're most welcome.
i'm glad i could help.