1 excel sheet with many reports

[Phill032]

Hi, i have the below CSV file that when i download from our system has all reports on the one sheet. How can i load convert this to each report being on a different sheet/table in power query. A small snippet of the data below.
Note the headers of each report i have highlighted.

Department Profit DSA Report2023090880713368.csv
	A	B	C	D	E	F	G
1	Company_Name	Branch_Name	Department_Name	Original_MTD_Budget_Amt	MTD_Budget_Amt	MTD_Actual_Amt	MTD_Variance_Amt
2	OSPK Pty Ltd	PARK KIA	New Vehicles	42197	42197	-25611.72	67808.72
3	OSPK Pty Ltd	PARK KIA	Used Vehicles	-4064	-4064	-85187.18	81123.18
4	OSPK Pty Ltd	PARK KIA	Aftermarket	29654	29654	23519.4	6134.6
5	Source	Company_Key	Company_Name	Branch_Key	Branch_Name	Department_Order	PAndL_View_Order
6	Sales/COGS	1	OSPK Pty Ltd	1	PARK KIA	6	1
7	Sales/COGS	1	OSPK Pty Ltd	1	PARK KIA	7	1
8	Source	Company_Key	Company_Name	Branch_Key	Branch_Name	Section_ID	Account_Group_ID
9	Expense/Income	1	OSPK Pty Ltd	1	PARK KIA	6
10	Expense/Income	1	OSPK Pty Ltd	1	PARK KIA	6
11	Expense/Income	1	OSPK Pty Ltd	1	PARK KIA	6	61
12	Expense/Income	1	OSPK Pty Ltd	1	PARK KIA	6	61
13	Source	Company_Key	Company_Name	Branch_Key	Branch_Name	Department_Order	Department_ID
14	Statistic	1	OSPK Pty Ltd	1	PARK KIA	6	6
15	Statistic	1	OSPK Pty Ltd	1	PARK KIA	7	7
16	Statistic	1	OSPK Pty Ltd	1	PARK KIA	10	10
17	Statistic	1	OSPK Pty Ltd	1	PARK KIA	-1	-1
18	Statistic	1	OSPK Pty Ltd	1	PARK KIA	6	6
19	Statistic	1	OSPK Pty Ltd	1	OSBORNE PARK KIA	7	7
Department Profit DSA Report202

 

[smozgur]

I don't think that PQ will help you in this case, because you can only get one sheet result from PQ.

I will also watch this thread to hear from the PQ experts for ideas, but in the meantime, a simple VBA code might help you for this in case each header contains at least one same column name, like Company_Name as I can see in the sample data.

Sub separateData()
Dim rng As Range
Dim fnd1 As Range
Dim fnd2 As Range
Dim block As Range
Dim sht As Worksheet
    
    Cells(1, 1).Activate
    Selection.CurrentRegion.Cells(Selection.CurrentRegion.Rows.Count + 1, 1) = "Company_Name"
    Set rng = Selection.CurrentRegion
    
    Set fnd1 = rng.Cells(1, 1)
    Set fnd2 = rng.Cells.Find("Company_Name")
    
    Do
        Set block = Range(fnd1.EntireRow.Cells(1, 1), fnd2.EntireRow.Offset(-1).Cells(1, 1)).Resize(, rng.Columns.Count)
        Set sht = ActiveWorkbook.Worksheets.Add(after:=ActiveSheet)
        block.Copy sht.Cells(1, 1)
        Set fnd1 = fnd2
        Set fnd2 = rng.FindNext(fnd2)
    Loop Until fnd2.Row <= fnd1.Row
    
    fnd1.EntireRow.Delete xlShiftUp
    
End Sub

 

[Phill032]

I don't think that PQ will help you in this case, because you can only get one sheet result from PQ.

I will also watch this thread to hear from the PQ experts for ideas, but in the meantime, a simple VBA code might help you for this in case each header contains at least one same column name, like Company_Name as I can see in the sample data.

Sub separateData()
Dim rng As Range
Dim fnd1 As Range
Dim fnd2 As Range
Dim block As Range
Dim sht As Worksheet
   
    Cells(1, 1).Activate
    Selection.CurrentRegion.Cells(Selection.CurrentRegion.Rows.Count + 1, 1) = "Company_Name"
    Set rng = Selection.CurrentRegion
   
    Set fnd1 = rng.Cells(1, 1)
    Set fnd2 = rng.Cells.Find("Company_Name")
   
    Do
        Set block = Range(fnd1.EntireRow.Cells(1, 1), fnd2.EntireRow.Offset(-1).Cells(1, 1)).Resize(, rng.Columns.Count)
        Set sht = ActiveWorkbook.Worksheets.Add(after:=ActiveSheet)
        block.Copy sht.Cells(1, 1)
        Set fnd1 = fnd2
        Set fnd2 = rng.FindNext(fnd2)
    Loop Until fnd2.Row <= fnd1.Row
   
    fnd1.EntireRow.Delete xlShiftUp
   
End Sub

Hi, thanks for that. This VBA does work not want i was planning but i think i can make it work for me.

Cheers!

 

[smozgur]

The VBA works exactly as needed for the provided sample data. Takes each section and put that range into a separate worksheet.
However, as you also mentioned, it is just "a small snippet of the data" and the code surely needs to be adjusted for the real data you have.

Let us know if you have any difficulties adjusting it.

 

[Phill032]

The VBA works exactly as needed for the provided sample data. Takes each section and put that range into a separate worksheet.
However, as you also mentioned, it is just "a small snippet of the data" and the code surely needs to be adjusted for the real data you have.

Let us know if you have any difficulties adjusting it.

So all reports seperate out except 1, is there a chance that you could add like a second criteria. The report does not have the Company_Name but does have a Company_Key header name. it's honestly not much hassle to cut and paste it into a new page but if it is possible and not too much hassle??

 

[smozgur]

So, there is no same header repeating on each section header.

If "Company_" stil exists in each header (not in the data), then I think we can use the following modified code.

Sub separateData()
Dim rng As Range
Dim fnd1 As Range
Dim fnd2 As Range
Dim block As Range
Dim sht As Worksheet
Dim strKey As String

    strKey = "Company_"
    
    Cells(1, 1).Activate
    Selection.CurrentRegion.Cells(Selection.CurrentRegion.Rows.Count + 1, 1) = strKey
    Set rng = Selection.CurrentRegion
    
    Set fnd1 = rng.Cells(1, 1)
    Set fnd2 = rng.Cells.Find(strKey)
    
    Do
        If fnd1.Row <> fnd2.Row Then
            Set block = Range(fnd1.EntireRow.Cells(1, 1), fnd2.EntireRow.Offset(-1).Cells(1, 1)).Resize(, rng.Columns.Count)
            Set sht = ActiveWorkbook.Worksheets.Add(after:=ActiveSheet)
            block.Copy sht.Cells(1, 1)
        End If
        Set fnd1 = fnd2
        Set fnd2 = rng.FindNext(fnd2)
    Loop Until fnd2.Row < fnd1.Row
    
    fnd1.EntireRow.Delete xlShiftUp
    
End Sub

 

[Phill032]

So, there is no same header repeating on each section header.

If "Company_" stil exists in each header (not in the data), then I think we can use the following modified code.

Sub separateData()
Dim rng As Range
Dim fnd1 As Range
Dim fnd2 As Range
Dim block As Range
Dim sht As Worksheet
Dim strKey As String

    strKey = "Company_"
   
    Cells(1, 1).Activate
    Selection.CurrentRegion.Cells(Selection.CurrentRegion.Rows.Count + 1, 1) = strKey
    Set rng = Selection.CurrentRegion
   
    Set fnd1 = rng.Cells(1, 1)
    Set fnd2 = rng.Cells.Find(strKey)
   
    Do
        If fnd1.Row <> fnd2.Row Then
            Set block = Range(fnd1.EntireRow.Cells(1, 1), fnd2.EntireRow.Offset(-1).Cells(1, 1)).Resize(, rng.Columns.Count)
            Set sht = ActiveWorkbook.Worksheets.Add(after:=ActiveSheet)
            block.Copy sht.Cells(1, 1)
        End If
        Set fnd1 = fnd2
        Set fnd2 = rng.FindNext(fnd2)
    Loop Until fnd2.Row < fnd1.Row
   
    fnd1.EntireRow.Delete xlShiftUp
   
End Sub

Yes, that did the trick.. perfect. thanks so much for your help!!

 

[smozgur]

Yes, that did the trick.. perfect. thanks so much for your help!!

You're welcome. Glad to hear it helps.

That would be great if you could mark the post as the solution that answered the question in order to help future readers.

 

[Phill032]

You're welcome. Glad to hear it helps.

That would be great if you could mark the post as the solution that answered the question in order to help future readers.

Done. Cheers!

 

[smozgur]

Done. Cheers!

Thanks.