Condition on filtered data
Solved
Akalia
Posted messages
34
Status
Member
-
Akalia Posted messages 34 Status Member -
Akalia Posted messages 34 Status Member -
Hello,
Always in my indicators project, I’m currently hitting a wall as they say. I’ll describe what I’m doing and what I want in several points:
- Create a first filter that sorts data on Sheet1.
- On this existing filter, perform a second sort also on the data from Sheet1.
- Create a condition to search in column BV when the current date is greater than the dates (Now > La_date) where La_date is a date that can be either before or after today.
- Return all the filtered rows that meet the condition to another sheet named "Feuil3", copying only certain columns.
I have written code, but I feel the obstacle is applying the condition on a filter, because I apply the filter then the condition, but it seems the condition doesn’t take the filtering into account, or perhaps the pasted data isn’t taking it into account. So I’ve resorted to splitting steps by opening a new Sheet2 and completing the last part of what I want to obtain. I’ll show you the code that works, but my question is: is it possible to do what I’m doing without going through this intermediate sheet?
Here is the code:
Option Explicit
-----------------------------------------------------
Private Sub CommandButton1_Click()
'Dim Dernligne As Integer, Lig As Integer, Lg As Integer
Dim La_date As Date
Dim Date_test As Date
Dim n As Integer
Date_test = Now()
Dim DerColonne As Integer
Dim Cl As Integer
Dim dernligne As Integer, T_statut
Dim cptr As Byte, Statut As String
Dim Idx As Integer, Nbre As Integer
'Cache les traitements et défilements
Application.CutCopyMode = False
Application.ScreenUpdating = False
'Ajout de la feuille test
Sheets.Add.Name = "test"
'Nettoyage des anciennes données précédentes
Sheets("Feuil3").Select
Range("A2:CX10000").Select
Selection.Delete
'On enlève tous les filtres déjà présents
Sheets("Feuil1").AutoFilterMode = False
'Filtrage 1
Selection.AutoFilter
Worksheets("Feuil1").Range("A2:CX65536").AutoFilter Field:=42, Criteria1:="=Ordre de fabrication", Operator:=xlOr, Criteria2:="=OF non standard"
'Sous filtrage en fonction du statut Lancé
Selection.AutoFilter
Worksheets("Feuil1").Range("A2:CX65536").AutoFilter Field:=75, Criteria1:="Lancé"
Dim Lg As Integer
Dim Lig As Integer
Dim ligne As String
dernligne = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
Lg = 1
'Boucle sur les lignes
For Lig = 3 To dernligne (car la première date commence ligne 3)
La_date = Sheets("Feuil1").Range("BV" & Lig).Value
If La_date < Now Then
Sheets("Feuil1").Select
Range("A" & Lig & ":BW" & Lig).Select
Selection.Copy
'collage dans synthese
Sheets("Feuil2").Select
Lg = Lg + 1
Range("A" & Lg).Select
ActiveSheet.Paste
End If
Next
'Filtrage des types d'OF en standard et non standard
'Selection.AutoFilter
Worksheets("Feuil2").Range("A2:CX65536").AutoFilter Field:=42, Criteria1:="=Ordre de fabrication", Operator:=xlOr, Criteria2:="=OF non standard"
'Sous filtrage en fonction du statut Lancé
'Selection.AutoFilter
Worksheets("Feuil2").Range("A2:CX65536").AutoFilter Field:=75, Criteria1:="Lancé"
With Sheets("Feuil2")
Union(.Columns(3), .Columns(4), .Columns(5), .Columns(42), .Columns(47), .Columns(49), .Columns(52), .Columns(54), .Columns(55), .Columns(67), .Columns(74)).Copy Sheets("Feuil3").Range("A1")
End With
Application.DisplayAlerts = False
Sheets("Feuil2").Delete
Application.DisplayAlerts = True
End Sub
Thank you in advance if a solution is possible, because already the problem I had before is that it did not copy/paste the filtered data, only those with the date condition. Then, that’s why I did a second filter again.
Configuration: Windows XP / Firefox 17.0
Always in my indicators project, I’m currently hitting a wall as they say. I’ll describe what I’m doing and what I want in several points:
- Create a first filter that sorts data on Sheet1.
- On this existing filter, perform a second sort also on the data from Sheet1.
- Create a condition to search in column BV when the current date is greater than the dates (Now > La_date) where La_date is a date that can be either before or after today.
- Return all the filtered rows that meet the condition to another sheet named "Feuil3", copying only certain columns.
I have written code, but I feel the obstacle is applying the condition on a filter, because I apply the filter then the condition, but it seems the condition doesn’t take the filtering into account, or perhaps the pasted data isn’t taking it into account. So I’ve resorted to splitting steps by opening a new Sheet2 and completing the last part of what I want to obtain. I’ll show you the code that works, but my question is: is it possible to do what I’m doing without going through this intermediate sheet?
Here is the code:
Option Explicit
-----------------------------------------------------
Private Sub CommandButton1_Click()
'Dim Dernligne As Integer, Lig As Integer, Lg As Integer
Dim La_date As Date
Dim Date_test As Date
Dim n As Integer
Date_test = Now()
Dim DerColonne As Integer
Dim Cl As Integer
Dim dernligne As Integer, T_statut
Dim cptr As Byte, Statut As String
Dim Idx As Integer, Nbre As Integer
'Cache les traitements et défilements
Application.CutCopyMode = False
Application.ScreenUpdating = False
'Ajout de la feuille test
Sheets.Add.Name = "test"
'Nettoyage des anciennes données précédentes
Sheets("Feuil3").Select
Range("A2:CX10000").Select
Selection.Delete
'On enlève tous les filtres déjà présents
Sheets("Feuil1").AutoFilterMode = False
'Filtrage 1
Selection.AutoFilter
Worksheets("Feuil1").Range("A2:CX65536").AutoFilter Field:=42, Criteria1:="=Ordre de fabrication", Operator:=xlOr, Criteria2:="=OF non standard"
'Sous filtrage en fonction du statut Lancé
Selection.AutoFilter
Worksheets("Feuil1").Range("A2:CX65536").AutoFilter Field:=75, Criteria1:="Lancé"
Dim Lg As Integer
Dim Lig As Integer
Dim ligne As String
dernligne = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
Lg = 1
'Boucle sur les lignes
For Lig = 3 To dernligne (car la première date commence ligne 3)
La_date = Sheets("Feuil1").Range("BV" & Lig).Value
If La_date < Now Then
Sheets("Feuil1").Select
Range("A" & Lig & ":BW" & Lig).Select
Selection.Copy
'collage dans synthese
Sheets("Feuil2").Select
Lg = Lg + 1
Range("A" & Lg).Select
ActiveSheet.Paste
End If
Next
'Filtrage des types d'OF en standard et non standard
'Selection.AutoFilter
Worksheets("Feuil2").Range("A2:CX65536").AutoFilter Field:=42, Criteria1:="=Ordre de fabrication", Operator:=xlOr, Criteria2:="=OF non standard"
'Sous filtrage en fonction du statut Lancé
'Selection.AutoFilter
Worksheets("Feuil2").Range("A2:CX65536").AutoFilter Field:=75, Criteria1:="Lancé"
With Sheets("Feuil2")
Union(.Columns(3), .Columns(4), .Columns(5), .Columns(42), .Columns(47), .Columns(49), .Columns(52), .Columns(54), .Columns(55), .Columns(67), .Columns(74)).Copy Sheets("Feuil3").Range("A1")
End With
Application.DisplayAlerts = False
Sheets("Feuil2").Delete
Application.DisplayAlerts = True
End Sub
Thank you in advance if a solution is possible, because already the problem I had before is that it did not copy/paste the filtered data, only those with the date condition. Then, that’s why I did a second filter again.
Configuration: Windows XP / Firefox 17.0
3 answers
-
Hello
Why filter before and not rather just copy only the values that meet the 3 conditions?
Example a table with in column B the days, in column C the department and in column E the date; I only want to copy the dates of today that are Mondays for the accounting department
For lig=3 to dernligne
le_jour=range("B" & lig)
le_service=range("C" & lig)
la_date=range("E" & lig)
If le_jour="lundi" and le_service="compta" and la_date<now then="" sheets="" range="" lig="" selection.copy="" etc="" cdlmnt="" imagination="" is="" more="" important="" than="" knowledge.="" a.="" einstein="" />