PDA

View Full Version : Advance Filter



IgnBan
06-05-2008, 11:21 AM
I have a workbook that XLD (Bob, congratulations on your recognition) helped me configure with a very cleaver filter. Now I need it to make another sheet to filter the same criteria but adding another criteria in column?W?.
Attached WB;
I need to filter the ERRORS sheet the way is in sheet ExistingFilter but adding the criteria EAST, WEST, NORTH, SOUTH that is enter in column ?W?
So in the IntendedFilter sample Sheet I show how I need to be able to extract the same information as the ExistingFilter but only the ones that meet the criteria Ex. NORTH and sort it by Unit Number, same way it does the ExistingFilter highlighting the first instance of the Unit .

Private Sub Worksheet_Activate()
Dim mpLastRow As Long
Dim mpNextRow As Long
Dim mpTargetRow As Long
ActiveSheet.Unprotect
mpLastRow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
With Me.Rows("2:" & mpLastRow + 500)
.Borders(xlLeft).LineStyle = xlNone
.Borders(xlRight).LineStyle = xlNone
.Borders(xlTop).LineStyle = xlNone
.Borders(xlBottom).LineStyle = xlNone
.ClearContents
.Font.Bold = False
End With
mpNextRow = 4
With Worksheets("ERRORS")
mpTargetRow = 2
For Each mpRow In .UsedRange.Rows
If mpRow.Cells(1, "B").Value = "Needs Repair" Then
mpRow.Cells(1, "B").Resize(, 5).Copy
Me.Cells(mpNextRow, "B").PasteSpecial Paste:=xlPasteValues
If Me.Cells(mpNextRow, "C").Value <> Me.Cells(mpNextRow - 1, "C").Value Then
Me.Cells(mpNextRow, "A").Value = _
Application.Max(Me.Range(Me.Range("A1"), Me.Cells(mpNextRow, "A").Offset(-1, 0))) + 1
Me.Cells(mpNextRow, "A").Resize(, 6).Font.Bold = True
End If
mpNextRow = mpNextRow + 1
End If
Next mpRow
End With
mpLastRow = Me.Cells(Me.Rows.Count, "B").End(xlUp).Row
If mpLastRow > 1 Then
With Me.Range("A1").Resize(mpLastRow, 6)
.BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
.Borders(xlEdgeTop).LineStyle = xlNone
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
End With
End With
End If
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowSorting:=True, AllowFiltering:=True
ActiveSheet.EnableSelection = xlUnlockedCells
Me.Range("A1").Select
End Sub


Any help is in advance appreciated!:thumb

mano2004
06-06-2008, 12:25 PM
:dunno
:thumb

IgnBan
06-06-2008, 12:50 PM
Eu n?o compreendo

IgnBan
06-06-2008, 01:28 PM
I've modified to filter column "W" categories, now I need help inserting this column after Unit Number.
Ex. "NORTH"


Private Sub Worksheet_Activate()
Dim mpLastRow As Long
Dim mpNextRow As Long
Dim mpTargetRow As Long
ActiveSheet.Unprotect
mpLastRow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
With Me.Rows("2:" & mpLastRow + 500)
.Borders(xlLeft).LineStyle = xlNone
.Borders(xlRight).LineStyle = xlNone
.Borders(xlTop).LineStyle = xlNone
.Borders(xlBottom).LineStyle = xlNone
.ClearContents
.Font.Bold = False
End With
mpNextRow = 4
With Worksheets("ERRORS")
mpTargetRow = 22
For Each mpRow In .UsedRange.Rows
If mpRow.Cells(1, "W").Value = "NORTH" Then
mpRow.Cells(1, "B").Resize(, 5).copy
Me.Cells(mpNextRow, "B").PasteSpecial Paste:=xlPasteValues
If Me.Cells(mpNextRow, "C").Value <> Me.Cells(mpNextRow - 1, "C").Value Then
Me.Cells(mpNextRow, "A").Value = _
Application.Max(Me.Range(Me.Range("A1"), Me.Cells(mpNextRow, "A").Offset(-1, 0))) + 1
Me.Cells(mpNextRow, "A").Resize(, 6).Font.Bold = True
End If
mpNextRow = mpNextRow + 1
End If
Next mpRow
End With
mpLastRow = Me.Cells(Me.Rows.Count, "B").End(xlUp).Row
If mpLastRow > 1 Then
With Me.Range("A1").Resize(mpLastRow, 6)
.BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
.Borders(xlEdgeTop).LineStyle = xlNone
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
End With
End With
End If
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowSorting:=True, AllowFiltering:=True
ActiveSheet.EnableSelection = xlUnlockedCells
Me.Range("A1").Select
End Sub