Filtering and saving in each macro filter

[eliranyan]

An addition to the code is missing - in each filter the file will be saved in a specific path, with the name consisting of:
1. Cell A1
2. Two months back from today,
3. A year - of the same month - that is, two months back from today in the year 2022
Every month runs the macro.
The result: saving the number of files as the number of filters in a specific path named month year (two months back) and cell A1
‏
‏

Option Explicit

Public Sub FilterByColumnA()
Dim ws As Worksheet
Set ws = Worksheets("SHBZ")

Dim tableRange As Range
Set tableRange = ws.Range("A2", ws.Range("A" & ws.Rows.Count).End(xlUp))

Dim item, Items
Items = UniqueItems(tableRange, vbTextCompare)

ws.Range("A1").AutoFilter

For Each item In Items
ws.Range("A1").AutoFilter field:=1, Criteria1:=item

SaveWorkbookToItem item.Value
Next item

Set ws = Nothing
Set tableRange = Nothing
End Sub

Private Function UniqueItems(ByVal r As Range, _
Optional ByVal Compare As VbCompareMethod = vbBinaryCompare, _
Optional ByRef Count) As Variant

'Return an array with all unique values in R
' and the number of occurrences in Count
Dim Area As Range, Data
Dim i As Long, j As Long
Dim Dict As Object 'Scripting.Dictionary
Set r = Intersect(r.Parent.UsedRange, r)
If r Is Nothing Then
UniqueItems = Array()
Exit Function
End If

Set Dict = CreateObject("Scripting.Dictionary")
Dict.CompareMode = Compare

For Each Area In r.Areas
Data = Area
If IsArray(Data) Then
For i = 1 To UBound(Data)
For j = 1 To UBound(Data, 2)
If Not Dict.Exists(Data(i, j)) Then
Dict.Add Data(i, j), 1
Else
Dict(Data(i, j)) = Dict(Data(i, j)) + 1
End If
Next
Next
Else
If Not Dict.Exists(Data) Then
Dict.Add Data, 1
Else
Dict(Data) = Dict(Data) + 1
End If
End If
Next
UniqueItems = Dict.Keys
Count = Dict.Items
End Function

Private Sub SaveWorkbookToItem(item As String)
Const path = "C:\logs\"
ActiveWorkbook.SaveAs path & Format(Date - 30, "mm YYYY") & "SHBZ" & item & ".xlsx"
End Sub

 

[eliranyan]

some one can help i did not know how to save loop every filter ? the code not work

 

[eliranyan]

this is the database

company

name

r-h

m-e

h

name h

m.e

name e

invest

h,z

2

smal

name s

0​

m-s

1​

MZ​

5​

ZXDS​

רום​

40​

2​

800​

0​

0.50​

1​

MZR​

4​

EDR​

דבש​

40​

2​

800​

0​

0.50​

1​

MZ​

4​

SSS​

אגוזי​

40​

2​

800​

0​

0.06​

1​

MZR​

2​

AAA​

תפוח​

​

40​

2​

800​

0​

0.75​

1​

MZ​

1​

RRT​

חצי.ג​

​

40​

2​

800​

0​

0.88​

1​

MZR​

11​

RERUY​

רום​

​

40​

2​

800​

0​

1.00​

1​

MZ​

11​

ZXDS​

דבש​

​

40​

2​

800​

0​

1.00​

2​

MZR​

10​

EDR​

אגוזי​

​

40​

2​

800​

0​

1.00​

2​

MZ​

11​

SSS​

תפוח​

​

40​

2​

800​

0​

1.00​

2​

MZR​

12​

AAA​

חצי.ג​

​

50​

2​

800​

0​

-0.25​

3​

MZ​

13​

RRT​

רום​

​

40​

2​

800​

0​

0.87​

3​

MZR​

14​

RERUY​

דבש​

​

40​

2​

800​

0​

1.00​

3​

MZ​

15​

ZXDS​

רום​

​

40​

0​

800​

0​

0.25​

3​

MZR​

16​

EDR​

רום​

​

40​

2​

800​

0​

0.25​

3​

MZ​

17​

SSS​

דבש​

​

40​

2​

800​

0​

0.40​

3​

MZR​

18​

AAA​

אגוזי​

​

40​

2​

800​

0​

1.00​

3​

MZ​

19​

RRT​

תפוח​

​

50​

2​

800​

0​

-0.40​

3​

MZR​

20​

RERUY​

חצי.ג​

​

40​

2​

800​

0​

0.75​

3​

MZ​

22​

ZXDS​

רום​

​

50​

2​

800​

0​

-0.23​

3​

MZR​

23​

EDR​

דבש​

​

40​

2​

800​

0​

0.16​

4​

MZ​

24​

SSS​

אגוזי​

​

40​

2​

800​

0​

0.75​

10​

MZR​

25​

AAA​

רום​

​

50​

0​

800​

0​

-0.25​

10​

MZ​

26​

RRT​

דבש​

​

40​

0​

800​

0​

0.23​

10​

MZR​

27​

RERUY​

אגוזי​

​

50​

0​

800​

0​

-0.40​

10​

MZ​

28​

ZXDS​

תפוח​

​

40​

0​

800​

0​

0.40​