YourBroLucas
New Member
- Joined
- Jul 11, 2022
- Messages
- 29
- Office Version
- 2016
- Platform
- Windows
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:
With love ♥,
Lucas
I managed to make it work with one criterion just fine, but not two.
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.
- For Each 1 (For Each 2 (If 1 (If 2 (Action)))
- If 1 AND If 2 (For Each 1 (Action); For Each 2 (Action)
- If 1 then (For Each 1 (Action)), If 2 then (For Each 2 (Action))
- 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.
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
VBA Code:
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.
VBA Code:
' 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
VBA Code:
' 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