Jul 19 2020 06:08 AM
Jul 19 2020 06:08 AM
Please find here below the structure of the data I am working on, I would like to get some help to find a way that when I export the data from Power Query I am able to achieve 2 things.
1) The data for each area ( Column State ) goes into a separate Excel worksheet of the file. I have about 300+ areas so using the reference and add filter at state column may not be a smart way to work.
2) Additionally it would be great that the sheet gets renamed to the area name.
Look forward to some help on this please
Jul 19 2020 08:48 AM
Unfortunately, PowerQuery doesn't support output of one query to multiple sheets.
If your version of Excel supports Dynamic Arrays and the FILTER function, you can use this code:
Option Explicit Public Sub SplitTableToSheets() Dim full_data_listobject As ListObject Dim selected_range As Range Dim selected_data As Variant Dim selected_data_header As String Dim items_sheet As Worksheet Dim items_range As Range Dim item As String Dim i As Integer Dim new_item_sheet As Worksheet DeleteSheetWithoutWarning "items" Set full_data_listobject = ThisWorkbook.Worksheets("full data").ListObjects(1) ' get the range currently selected Set selected_range = Selection selected_data_header = Selection.Offset(-1, 0).Cells(1, 1) Set items_sheet = ThisWorkbook.Worksheets.Add items_sheet.Name = "items" selected_range.Copy items_sheet.Range("A1").PasteSpecial xlValues Set items_range = items_sheet.Range("A1").CurrentRegion items_range.RemoveDuplicates 1, xlNo 'loop through each item and create a new sheet with the filtered data For i = 1 To items_range.Rows.Count If items_range.Cells(i, 1) <> "" Then item = items_range.Cells(i, 1) DeleteSheetWithoutWarning item Set new_item_sheet = ThisWorkbook.Worksheets.Add With new_item_sheet .Name = item .Range("A1").Formula2 = "=" & full_data_listobject.Name & "[#Headers]" .Range("A2").Formula2 = "=FILTER(" & full_data_listobject.Name & _ "," & full_data_listobject.Name & "[" & selected_data_header & "] = """ & item & """)" ''optionally uncomment these two lines to paste the results as values in the destination sheet '.Range("A1").CurrentRegion.Copy '.Range("A1").PasteSpecial xlPasteValues End With Else Exit For End If Next i End Sub Private Sub DeleteSheetWithoutWarning(sheet_name As String) Application.DisplayAlerts = False On Error Resume Next ThisWorkbook.Worksheets(sheet_name).Delete On Error GoTo 0 Application.DisplayAlerts = True End Sub
Select a column in your data that contains the items you want to split by, then run the SplitTableToSheets sub-procedure.
The benefit of this is that it will keep the sub-sheets up to date when the data on the main sheet refreshes.
You can test it with my dataset using the attached file.
If this doesn't work for you because you don't have access to the FILTER function, let me know. There are other ways to do it.
Jul 20 2020 06:41 AM
Thank you the help.
I am using office 365 and am able to use Dynamic arrays. I tried using your sample sheet on my system and seem to have run into a error here.
I am not VBA aware, sharing here with you the debug screen shot for runtime error 1004.
Do please help further on this.
Jul 20 2020 06:53 AM
Please make sure you have selected just the data rows in the column and not the entire column. It should be like this (i.e. the header is not selected):
To do this, you hover your cursor over the column header until you see the black arrow to select the column, then select and it will just select the data and not the header.
This is wrong (entire column is selected):
Please try this and let me know how you get on.
Jul 20 2020 08:02 AM
Thank you. Works just the way its expected.
Mar 09 2021 08:05 PM - edited Mar 10 2021 09:48 PM
Thanks I am lucky to find your solution here, I also have this problem.
I tried your solution, however, I have 1 column is Date format, in your coding, the result will change to value format, do you know how to make it remain the same with original sheet? thanks.
Mar 13 2021 12:23 PM
Apr 30 2021 05:41 AM
Apr 30 2021 05:47 AM
Apr 30 2021 07:00 AM
@AW65 Are you sure it's an untouched version? I just downloaded the file from the thread and the code ran without problem. I also ran it twice in a row and it worked without problem. Perhaps you have different macro security settings in your application?
When I run the macro, the range is not still selected at the end. Just cell A1 of the most recently produced sheet.
Apr 07 2022 06:28 AM
I just downloaded and tried to run the file as is. It goes immediately to Debug:
Private Sub DeleteSheetWithoutWarning(sheet_name As String)
Application.DisplayAlerts = False
On Error Resume Next
On Error GoTo 0
Application.DisplayAlerts = True
May 15 2022 10:02 PM
you saved my life I love you, you a re a genius, thanks for sharing this @OwenPrice