VBA: Multiple 'If' + 'And' + multiple 'For Each': Please send help.

[YourBroLucas]

Howdy,

So I have this Macro supposed to filter and paste a general dynamic table for 2 criteria in two different fields.

I want both If statements to be true in order to copy/paste the data, so I tried the following macro.

Notes:

• There is no error message, but nothing happens.
• Fields: Dir and Type, c = criteria, s = selected
• Criteria are selected from dropdown lists in shtTotal B6 and B7

• I suppose that I need to put two 'For Each' loops since they deal with different arrays.
• → Thus I suppose I need to put 'Next sType' just like I put 'Next sDir', but how and where?
• I wonder if it is possible to do the same thing with even more criteria, like 5 of them.

I've also tried these structures:

1. For Each 1 (For Each 2 (If 1 (If 2 (Action)))
2. If 1 AND If 2 (For Each 1 (Action); For Each 2 (Action)
3. If 1 then (For Each 1 (Action)), If 2 then (For Each 2 (Action))
4. For Each 1 (If 1 then (Action)), For Each 2 (If 2 then (Action))

• As a sidequest, I have issues with shtGen.ShowAllData, often gives an error message, when nothing is hidden in the sheet.
• → Thus I wish to create an If statement to verify if any row is already hidden before executing this line.

In addition, if you just so happen to have extra time, this is part of a bigger macro I'm trying to pull off.

Copy/paste dynamic, filtered data + put a column into next row (through macro)

Howdy dear forum members, Odd title I agree. So I have sheet 1, sheet 2, and sheet 3. Sheet 1 is the overall data entry dynamic table. Data is added through a User form (button "Add new entry") Sheet 2 is where filtered data (per department transactions) is exported through a macro (see...

www.mrexcel.com

With love ♥,
Lucas

Sub iNeedHelpForTheLoveOfGod()

' PART ONE: Multi-criteria export
' Sheets
    Dim shtGen As Worksheet
    Dim shtTotal As Worksheet
    Dim shtVar As Worksheet
    Set shtGen = ActiveWorkbook.Worksheets("Tab_Général")
    Set shtTotal = ActiveWorkbook.Worksheets("RECAP_TOTAL")
    Set shtVar = ActiveWorkbook.Worksheets("Variables")
'
' Arrays
    Dim arrDir As Variant, sDir As Variant
    Dim arrType As Variant, sType As Variant
    arrDir = Array("DICOM", "DAP", "DSJ", "DPJJ", "PVAM")
    arrType = Array(shtVar.Range("C2:C19"))
'
' Dynamic Range
    Dim LastRowGen As Long
    Dim LastRowTotal As Long
    Dim LastColumn As Long
    LastRowGen = shtGen.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    LastRowTotal = shtTotal.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'
    Dim RngGen As Range
    Dim RngTotal As Range
    Set RngGen = shtGen.Range("A16:P" & LastRowGen)
    Set RngTotal = shtTotal.Range("A16:P" & LastRowTotal)
'
' Criteria
    Dim StartCell As Range
    Dim cDir As Range
    Dim cType As Range
    Set StartCell = shtGen.Range("A16")
    Set cDir = shtTotal.Range("B6")
    Set cType = shtTotal.Range("B7")
'
' Filter
For Each sDir In arrDir
    If sDir = cDir And sType = cType Then
        RngTotal.Delete
        RngGen.AutoFilter
        RngGen.AutoFilter Field:=3, Criteria1:=sDir
        RngGen.AutoFilter Field:=14, Criteria2:=sType
        RngGen.Copy
        shtTotal.Range("A16").PasteSpecial Paste:=xlPasteAll
    Else
    End If
Next sDir
'
' Return to normal in shtGen
    Application.CutCopyMode = False
'    shtGen.ShowAllData
    shtGen.AutoFilterMode = False
'
' PART TWO: Put column P in next row?!
' PART THREE: Auto cell format
' PART FOUR: Success!
'
End Sub

I managed to make it work with one criterion just fine, but not two.

' The filter section that works
For Each sDir In arrDir
    If sDir = cDir Then
        shtTotal.Range("A16:P" & LastRowTotal).Delete
        shtGen.Range("A16:P" & LastRowGen).AutoFilter
        shtGen.Range("A16:P" & LastRowGen).AutoFilter Field:=3, Criteria1:=sDir
        shtGen.Range("A16:P" & LastRowGen).Copy
        shtTotal.Range("A16").PasteSpecial Paste:=xlPasteAll
    Else
    End If
Next sDir

' The filter section that doesn't work (detailed)
For Each sDir In arrDir
    If sDir = cDir And sType = cType Then
        shtTotal.Range("A16:P" & LastRowTotal).Delete
        shtGen.Range("A16:P" & LastRowGen).AutoFilter
        shtGen.Range("A16:P" & LastRowGen).AutoFilter Field:=3, Criteria1:=sDir
        shtGen.Range("A16:P" & LastRowGen).AutoFilter Field:=14, Criteria2:=sType
        shtGen.Range("A16:P" & LastRowGen).Copy
        shtTotal.Range("A16").PasteSpecial Paste:=xlPasteAll
    Else
    End If
Next sDir

 

[YourBroLucas]

And this is where it's supposed to end up in shtTotal (not the definitive design I promess )

Dropdown-Filter file.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P
6	Department	DICOM	<= static
7	Type	Audiovisuel	<= dynamic?
8
9	Date budget	<= +j restants
10
11	insight1	concatener dyn phrase based on criterias? (budget?)
12	insight2	Ce type représente X% du dept Y (AE)
13	insight3
14
15	N°	Date création	Direction	Bureau	Prestataire	Fiche com	BDC/EJ	AE antérieurs	AE	CP	Restant dû	SF	Justif. Écart	Type	.	.2
16
17
18
19
20
21
22
RECAP_TOTAL

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
K15:K172	Cell Value	=0	text	NO
K15:K172	Cell Value	<0	text	NO

Cells with Data Validation
Cell	Allow	Criteria
B6	List	=Variables!$A$2:$A$6
B7	List	=Variables!$C$2:$C$19

 

[Alex Blakenburg]

Have you tried Dante's code in Post #9 ?

Based on your XL2BB you need to make the below 2 changes in red below to the Post #9 code

  With shtGen.Range("A15:P" & lr)                                   ' Change from 16 to 15
    If cDir <> "" Then .AutoFilter 3, cDir Else .AutoFilter 3, "*"
    If cType <> "" Then .AutoFilter 14, cType Else .AutoFilter 14, "*"
  End With
  
  If shtGen.Range("C" & Rows.Count).End(3).Row > 16 Then
    shtGen.AutoFilter.Range.Offset(1).Copy shtTotal.Range("A16")    ' Added Offset(1)

 

[YourBroLucas]

Alright everyone,

So about the changes suggested by Alex, there was still an issue regarding the 'reinitialisation' of shtGen. Unfiltered results were still hidden on shtGen the same way shtTotal was.

Also, I had some issues with combinations that do not exist.

And lastly, the MsgBox did not show up.

I modified the macro a bit and it now definitely works (and most importantly it is "mistake proof").

Thank you everyone for your extensive help!!

(Though I still need to figure out how to put Row X's column P into Row X +1 dynamically)

Option Explicit

Sub CustomExport()
  Dim shtGen As Worksheet, shtTotal As Worksheet
  Dim cDir, cType
  Dim lr As Long
  Dim lrt As Long
  
  Set shtGen = ActiveWorkbook.Worksheets("Tab_Général")
  Set shtTotal = ActiveWorkbook.Worksheets("RECAP_TOTAL")

' shtGen show all
  shtGen.ListObjects("Tableau12").Range.AutoFilter Field:=3
  shtGen.ListObjects("Tableau12").Range.AutoFilter Field:=14
  shtGen.ListObjects("Tableau12").Sort.SortFields.Clear
  shtGen.ListObjects("Tableau12").Sort.SortFields.Add Key:=Range("Tableau12[[#All],[Date création]]"), SortOn:= _
  xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
       
' Clear former export
  If shtGen.AutoFilterMode Then shtGen.AutoFilterMode = False
  lr = shtGen.Range("C" & Rows.Count).End(3).Row
  shtTotal.Range("A16:P" & Rows.Count).ClearContents
  shtTotal.Range("A16:P" & Rows.Count).ClearFormats
  cDir = shtTotal.Range("B6").Value
  cType = shtTotal.Range("B7").Value
 
  With shtGen.Range("A15:P" & lr)
    If cDir <> "" Then .AutoFilter 3, cDir Else .AutoFilter 3, "*"
    If cType <> "" Then .AutoFilter 14, cType Else .AutoFilter 14, "*"
  End With
 
  If shtGen.Range("C" & Rows.Count).End(3).Row > 16 Then
    shtGen.AutoFilter.Range.Offset(1).Copy shtTotal.Range("A16")
    If shtGen.AutoFilterMode Then shtGen.AutoFilterMode = False
  Else
  End If
 
' shtGen show all + chronological order
  shtGen.ListObjects("Tableau12").Range.AutoFilter Field:=3
  shtGen.ListObjects("Tableau12").Range.AutoFilter Field:=14
  shtGen.ListObjects("Tableau12").Sort.SortFields.Clear
  shtGen.ListObjects("Tableau12").Sort.SortFields.Add Key:=Range("Tableau12[[#All],[Date création]]"), SortOn:= _
  xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   
  With shtGen.ListObjects("Tableau12").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
  End With

' Msg if no result
lrt = shtTotal.Range("A" & Rows.Count - 1).End(xlUp).Row
    With shtTotal.Range("A16:P" & lrt)
        If Application.WorksheetFunction.Sum(shtTotal.Range("A16:P" & lrt)) = 0 Then
            MsgBox "Aucun résultat trouvé"
        Else
        End If
    End With

End Sub

 

[DanteAmor]

Glad you got it sorted out!

----

shtGen.ListObjects("Tableau12")

But I see that you added a table in your code, which you hadn't mentioned in your OP.
From now on it is important that you mention all the elements of your sheet, as well as its structure, in this way you will receive more complete and effective answers. Since it is not the same to remove an autofilter from a sheet than from a table. As I mentioned from previous posts, my tests are effective with my test data.