Separate Downloaded Report Data into Separate Tabs or Workbooks?

[NewFrugal]

Hello; I genuinely appreciate your help in advance.

Monthly, I download a report with almost 40 departments that each need a separate report. The accounting system I use does not make this an easy task, as I have to manually copy each section of the report (each department) into a new sheet or copy the master sheet 40 times and delete all other departments from the sheet. For example, I have to create a new tab for Dept. 115 and delete all department numbers (and their respective data) before it and after it. This is too time-consuming and cumbersome. Is there a way that I can extract data into separate tabs or workbooks based on the department number? In essence, I would want the tabs to be named to the department number that is pulled, and the tab would only pull its respective information. I'm not sure if I'm making much sense, but here's a mini sheet of how the data is downloaded (example with about three departments). This is exactly how the report appears when downloaded. If there is some sort of VBA necessary, could you please help me by providing it? VBA is not my forte at all. Thanks again.

Feb. 2023 Department Summaries.xlsx
	A	B	C	D	E	F	G	H	I
1	Hogwarts School
2	2022-23 Department Report
3
4				Current Year YTD 02/28/2023	Budget 2022-23 06/30/2023	2022-23 Budget Remaining	Prior Year YTD 06/30/2022
5	100 - Classics
6	Expenses
7
8	01-6200-100	Resource Supplies-Classics		$940.95	$1,640.00	$699.05	$1,312.20
9	01-7045-100	Office Supplies-Classics		$0.00	$0.00	$0.00	$25.00
10	Total Expenses			$940.95	$1,640.00	$699.05	$1,337.20
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43	03/14/2023 4:09:46 PM							Page 1
44
45	Hogwarts School
46	2022-23 Department Report
47
48				Current Year YTD 02/28/2023	Budget 2022-23 06/30/2023	2022-23 Budget Remaining	Prior Year YTD 06/30/2022
49	101 - Computer Science
50	Expenses
51
52	01-6200-101	Resource Supplies-Computer Science		$0.00	$1,200.00	$1,200.00	$0.00
53	Total Expenses			$0.00	$1,200.00	$1,200.00	$0.00
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87	03/14/2023 4:09:46 PM							Page 2
88
89	Hogwarts School
90	2022-23 Department Report
91
92				Current Year YTD 02/28/2023	Budget 2022-23 06/30/2023	2022-23 Budget Remaining	Prior Year YTD 06/30/2022
93	102 - English
94	Expenses
95
96	01-6200-102	Resource Supplies-English		$904.10	$2,350.00	$1,445.90	$2,491.79
97	01-7045-102	Office Supplies-English		$422.74	$150.00	($272.74)	$209.46
98	Total Expenses			$1,326.84	$2,500.00	$1,173.16	$2,701.25
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131	03/14/2023 4:09:46 PM							Page 3
132
133	Hogwarts School
134	2022-23 Department Report
135
136				Current Year YTD 02/28/2023	Budget 2022-23 06/30/2023	2022-23 Budget Remaining	Prior Year YTD 06/30/2022
137	103 - Fine Arts
138	Expenses
139
140	01-6215-103	Art Supplies-Fine Arts		$3,202.36	$10,000.00	$6,797.64	$10,851.32
141	01-6220-103	Music Supplies-Fine Arts		$4,853.00	$15,000.00	$10,147.00	$197.65
142	01-6225-103	Band-Fine Arts		$2,463.39	$14,000.00	$11,536.61	$4,745.29
143	01-6230-103	Choral Arts-Fine Arts		$8,438.18	$12,500.00	$4,061.82	$6,623.92
144	01-7135-103	Photography-Fine Arts		$0.00	$8,000.00	$8,000.00	$2,044.20
145	Total Expenses			$18,956.93	$59,500.00	$40,543.07	$24,462.38
XTRA

 

[mumps]

Your data contains merged cells which almost always create problems for Excel macros. The macro below unmerges all the merged cells before creating the new sheets.

Sub CreateReports()
    Application.ScreenUpdating = False
    Dim school As Range, TE As Range, sAddr As String, lRow As Long, srcWS As Worksheet
    Set srcWS = Sheets("XTRA")
    lRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    With srcWS.Range("A1", Range("A" & Rows.Count).End(xlUp))
        .Cells.UnMerge
        .HorizontalAlignment = xlLeft
    End With
    Set school = srcWS.Range("A:A").Find("Hogwarts School")
    If Not school Is Nothing Then
        sAddr = school.Address
        Do
            Set TE = srcWS.Range("A" & school.Row & ":A" & lRow).Find("Total Expenses")
            Sheets.Add after:=Sheets(Sheets.Count)
            ActiveSheet.Name = srcWS.Range("A" & school.Row + 4)
            srcWS.Range("A" & school.Row & ":G" & TE.Row).Copy Range("A1")
            Columns.AutoFit
            Set school = srcWS.Range("A:A").Find(school, after:=school, LookIn:=xlValues, LookAt:=xlWhole)
        Loop While school.Address <> sAddr
        sAddr = ""
    End If
    Application.ScreenUpdating = True
End Sub

 

[NewFrugal]

Your data contains merged cells which almost always create problems for Excel macros. The macro below unmerges all the merged cells before creating the new sheets.

Sub CreateReports()
    Application.ScreenUpdating = False
    Dim school As Range, TE As Range, sAddr As String, lRow As Long, srcWS As Worksheet
    Set srcWS = Sheets("XTRA")
    lRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    With srcWS.Range("A1", Range("A" & Rows.Count).End(xlUp))
        .Cells.UnMerge
        .HorizontalAlignment = xlLeft
    End With
    Set school = srcWS.Range("A:A").Find("Hogwarts School")
    If Not school Is Nothing Then
        sAddr = school.Address
        Do
            Set TE = srcWS.Range("A" & school.Row & ":A" & lRow).Find("Total Expenses")
            Sheets.Add after:=Sheets(Sheets.Count)
            ActiveSheet.Name = srcWS.Range("A" & school.Row + 4)
            srcWS.Range("A" & school.Row & ":G" & TE.Row).Copy Range("A1")
            Columns.AutoFit
            Set school = srcWS.Range("A:A").Find(school, after:=school, LookIn:=xlValues, LookAt:=xlWhole)
        Loop While school.Address <> sAddr
        sAddr = ""
    End If
    Application.ScreenUpdating = True
End Sub

Thank you for your help, mumps. My next question is: do I need to enter some type of CTRL command in order for the new sheets to populate, or do I need to close the workbook and reopen it in order to copy the sheet for the cells to unmerge? Ideally, I don't want to continually have to copy the same sheet 40 times if there's a way to have the new sheets automatically populate from the unmerged cells.. So, I'm guessing the coding would need to search for the department number and name (e.g., 104 - Fine Arts), pull its data into a new sheet, and rename the sheet to the department code and name (i.e., 103 - Fine Arts), all while unmerging the cells since you stated that's one of the bigger issues.

 

[mumps]

The macro does exactly what you describe. Have you tried it?

 

[NewFrugal]

The macro does exactly what you describe. Have you tried it?

Yes, I tried it, and it didn't do anything. I made sure the file is an xlsm. Perhaps I saved the code in the wrong area, but I opened up the VBA module to do so.

 

[mumps]

I pasted the data you posted into an Excel sheet, ran the macro and it worked properly. Are you using the macro on the same data you posted?

 

[NewFrugal]

I pasted the data you posted into an Excel sheet, ran the macro and it worked properly. Are you using the macro on the same data you posted?

Yes, I'm using the same data. Sorry; VBA/macros are not my strength. So did you paste the code into a VBA module and run a macro?

 

[mumps]

I placed the macro in a standard module, Module1, and ran it.

 

[NewFrugal]

I re-did everything, and it worked! I guess I didn't run the macro correctly at all. Thanks!!!

 

[mumps]

You are very welcome.