Forum Discussion
Excel / VBA - filter data and save in new file
Hi All,
I need some help with Excel / VBA.
I have a dataset with a column with different categories and want to filter on each category and save the filtered data in a separate file. This way the other data will not be visible in that data. I have tried ChatGPT/Grok but it just not seem to work.
After a number of attempts, please see the VBA. The macro only creates Cat_A.xlsx and skips the rest with a "No data found" message. This is strange as the rest of the categories do have data.
Do you think you can help me?
===========================================
Sub ExportEachCategoryToFile()
Dim wsSource As Worksheet
Dim wbDest As Workbook
Dim lastRow As Long
Dim dataRange As Range, visibleRange As Range
Dim dict As Object, cell As Range
Dim cat As Variant
Dim fileName As String
Dim outputPath As String
Set wsSource = ThisWorkbook.Sheets("Data")
Set dict = CreateObject("Scripting.Dictionary")
' Define the path to save files
outputPath = ThisWorkbook.Path & Application.PathSeparator
' Determine the data range
lastRow = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row
Set dataRange = wsSource.Range("A1:E" & lastRow)
' Get unique categories from column C
For Each cell In wsSource.Range("C2:C" & lastRow)
If Not dict.exists(cell.Value) Then
dict.Add cell.Value, 1
End If
Next cell
' Loop through each category
For Each cat In dict.keys
' Clear any previous filters
If wsSource.FilterMode Then wsSource.ShowAllData
If wsSource.AutoFilterMode Then wsSource.AutoFilterMode = False
' Apply filter on Category (column 3)
dataRange.AutoFilter Field:=3, Criteria1:=cat
' Get visible rows
On Error Resume Next
Set visibleRange = dataRange.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
' If we have data, export
If Not visibleRange Is Nothing And visibleRange.Rows.Count > 1 Then
Set wbDest = Workbooks.Add(xlWBATWorksheet)
visibleRange.Copy Destination:=wbDest.Sheets(1).Range("A1")
wbDest.Sheets(1).Columns.AutoFit
fileName = outputPath & "Cat_" & cat & ".xlsx"
Application.DisplayAlerts = False
wbDest.SaveAs fileName, FileFormat:=xlOpenXMLWorkbook
wbDest.Close SaveChanges:=False
Application.DisplayAlerts = True
Else
MsgBox "No data for category '" & cat & "' – skipping.", vbInformation
End If
Set visibleRange = Nothing
Set wbDest = Nothing
Next cat
' Clear filters
If wsSource.FilterMode Then wsSource.ShowAllData
MsgBox "All category files saved successfully!", vbInformation
End Sub
===========================================
Thanks,
Naveen
3 Replies
This is caused by a quirk of Excel VBA. From Range.Rows property:
"When applied to a Range object that is a multiple selection, this property returns rows from only the first area of the range. For example, if the Range object someRange has two areas A1:B2 and C3:D4, someRange.Rows.Count returns 2, not 4. To use this property on a range that may contain a multiple selection, test Areas.Count to determine whether the range is a multiple selection."
The first time in the loop, the code filters for the first category it encountered, in row 2. So the visible range starts with an area that contains at least rows 1 and 2.
But the second time, row 2 is hidden because the code now filters for another category. So the visible range starts with an area that consists of the header row only, and visibleRange.Rows.Count returns 1.
Solution: change
If Not visibleRange Is Nothing And visibleRange.Rows.Count > 1 Then
to
If Not visibleRange Is Nothing And (visibleRange.Rows.Count > 1 Or visibleRange.Areas.Count > 1) Then
Hi Hans,
Thanks for this. The change in code does not yield the desired outcome. I still have the problem. Did you try the code yourself with the change? If so, please can you let me have the full file?
Thanks,
Naveen
Yes, I tested the code. Here is my test workbook with some dummy data. The macro produced multiple files:
