Excel Macro to create school reports - excel

hi everyone i need your help, i'm a school teacher with very minor knowledge of excel macros. I've created an excel worksheet with a table includes student names and lesson scores, i need a macro to create report for every student (every row of table) to a template that i created as report template
I've been looking so hard to find any tips or help on internet but no luck so far.
I've tried searching, and found a few examples, but none quite fit..such as this one.. create macro that will convert excel rows from single sheet to new sheets ..or this one.. Excel Macro that saves data inputted from one sheet onto successive rows in another sheet
Thank you so much

Please try and customize as you need, this code:
(my main table header is: student_id | name | surname | group)
Sub gen_reports()
Set ref_col = Application.Selection
Set ref_col = Application.InputBox("Select ID col of main table", xTitleId, ref_col.Address, Type:=8) ' select students from student_id col
For Each C In ref_col
Worksheets.Add.Name = C.Offset(0, 1) ' create a sheet for each student
ActiveSheet.Select
Range("a1").Value = "Report for " & C.Offset(0, 1) & " " & C.Offset(0, 2) & " / " & C.Offset(0, 3) ' fill each sheet with elements from each student
Next
End Sub
you can format the report(student's sheet) as you need, programatically. ex: Range("a1").Font.ColorIndex = 44 etc

Related

Linking rows in the main sheet to automatically created sheet

first of all I've read many topics but none has my solution.
I have a data of 4 columns and N Rows (as N is unknown number).
Here is a sample:
When a new row entered I want it to automatically create new sheet has the name which is written in title column of that row (for the first row, create sheet with name "M")
also copy all data in row M to the new sheet
i know there is a way
=<SheetName>!<cell> but it isn't really helps if i have for example 1000 columns,
i have to create 1000 sheet then copy 1000 times!!
that's all, thanks in advance.
also feel free to use any methods (such as VBA).
I think this could be messy especially if you end up with a lot of Data. The code below will allow you to run a Macro that will quickly create sheets based on the data. This macro will only work once but it does the job
Sub CopyRowsToSheet()
' Variables needed for the formula
Dim NofRows As Long
Dim i As Long
Dim iActive As Boolean
' Counting the number of Rows in the active sheet
With ActiveSheet
NofRows = .Range("A" & Rows.Count).End(xlUp).Row
' Cycling through the number of rows on the active sheet
' we have set i = 2 as there is a header on the first page. If there is no header then set i = 1
For i = 2 To NofRows
' Creating the new sheet
Worksheets.Add(, Sheets(Sheets.Count)).Name = "Row " & i
' Copy Data to new sheet
.Rows(i).Copy Sheets("Row " & i).Range("A1:D1")
Next i
End With
End Sub
Apologies not 100% sure how to make this automatic but if I find a way i will add it here for you

VBA for creating new sheets based on dynamic range in Index sheet

I am looking for experts' creation. I ran out of idea and dont think formula will do the trick I am after. In a workbook "schedule", there is the sheet "extractedData" extract information from another workbook. 2nd sheet "INDEX" will list required information from "extractedData". on "INDEX" sheet, date / DocNum / LotNum / ManDate / Qty will list from column A to E respectively. I am after some VBA magic that will create new sheets based on "INDEX" sheet and name each sheets based on DocNum range. The number of data in row will increase as more data coming in. Thanks the help.
Is that what you're looking for ?
Sub TEST()
For i = 1 to 10 'For example
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Worksheets("INDEX").Range("A" & i).Text
Next
End Sub

Print Timesheet PDFs

So my wife manages the timesheets for her employers company and has to print a pdf timesheet for each employee that worked on client A's project 1. For instance:
Client A - Project 1 - Employee 1 - Time & Expenses
Client A - Project 1 - Employee 2 - Time & Expenses
Client A - Project 1 - Employee 3 - Time & Expenses
Client A - Project 2 - Employee 2 - Time & Expenses
Client A - Project 2 - Employee 4 - Time & Expenses
Client A - Project 3 - Employee 3 - Time & Expenses
...
Client B - Project 1 - Employee 1 - Time & Expenses
Client B - Project 2 - Employee 2 - Time & Expenses
Client B - Project 2 - Employee 3 - Time & Expenses
Client B - Project 3 - Employee 1 - Time & Expenses
Client B - Project 3 - Employee 4 - Time & Expenses
...
etc.
My wife has a pretty regular workflow that honestly doesn't need much manual manipulation so I was trying to figure out how I can automate/streamline her workflow so she can spend more time with our son.
She can have up to 10 clients, and each client might have up to 20 active projects and she might have up to 10 employees per project. She has to do this every 15 days. She compiles all the PDFs into a merged pdf for the client's project and then manually enters the info into Quickbooks for creating a summarized invoice. The invoice is then merged with the individual timesheets. All the invoices then get distributed to each client. The process repeats perpetually.
Now I am by no means experienced with coding but I believe I know more about it than the average person. For me it's more of a hobby/activity I can do when its 110 degrees outside. What I have done so far is put together a powerquery that loads all the employee timesheets and filters and cleans up the information into one master data table. My current code "works" but takes a lot of time and is probably very inefficient. The summary of my process is:
Copy employee name column
Paste employee names on a separate worksheet (temp) range A1
Remove Duplicates so I have a column of unique names.
For each name, apply "Name" filter to my master data table.
Copy client column
Paste clients on temp range B1
Remove Duplicates so I have a column of unique clients the employee worked for.
For each client the employee worked for, apply "Client" filter to my master data table.
Copy project name column
Paste project names on temp C1
Remove duplicates so I have a column of unique project the employee worked on for the client.
For each project the employee worked on, apply "Project" filter to master data table.
Copy filtered data (visible cells only) from master data table
Paste data into preformatted worksheet (timesheet) table.
Apply filter to hide all blank rows in the timesheet table.
Print timesheet to pdf in a predetermined location.
Unhide rows from timesheet tables and clear contents for the next project.
I am looking for suggestions on how to improve my process to cut down on time, errors, and overall structure. I don't have any error handling in the code yet. Suggestions for that would be nice too, although ideally you have no errors right ;) . My long and ugly code is pasted below. I try to utilize variable but for some reason I get errors with them so I just rewrite the variable out and it works....
Public Sub EAS_AutoTS()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim wsTemp As Worksheet, po As Worksheet, que As Worksheet
Dim tempEmp As Range, tempClient As Range, tempProject As Range
Dim Emp As String, Client As String, Project As String
Dim PathName As String, SvAs As String
Dim e As Integer, c As Integer, p As Integer, ne As Integer, nc As Integer, np As Integer
Application.ScreenUpdating = False
PathName = ActiveWorkbook.Path
'Refresh Connection
wb.Connections("Query - Timesheets").Refresh
'Clear Filter on PrintOut Sheet
Set que = wb.Sheets("Data")
Set po = wb.Sheets("PrintOut")
'Create new sheet "Temp" and set Temp variable
'Sheets.Add After:=Data
'Sheets("Sheet1").Name = "Temp"
wb.Sheets("Temp").Visible = xlSheetVisible
Set wsTemp = wb.Sheets("Temp")
wsTemp.Cells.Clear
'Copy Name Column in query table to Temp Sheet A1
que.Range("A4").Select
que.AutoFilter.ShowAllData
que.Range("tblTS[Name]").Copy
wsTemp.Range("A1").PasteSpecial Paste:=xlPasteValues
'Remove Duplicates in the tempEmp Named Range to result in unique names only
wsTemp.Range("$A:$A").RemoveDuplicates Columns:=1, Header:=xlNo
'Create Dynamic Name Range for Employee Names
wb.Names.Add Name:="tempEmp", RefersTo:="=OFFSET(Temp!$A$1,0,0,COUNTA(Temp!$A:$A),1)"
'Set tempEmp = Range("tempEmp")
e = Range("tempEmp").Count
'Begin first for loop. First loop is for all employee names.
For ne = 1 To e
'Clear all filters in query table
que.Select
que.AutoFilter.ShowAllData
'Apply name to Printout sheet
po.Range("E1") = wsTemp.Range("A" & ne).Value
'Apply name filter to query table
que.Range("tblTS").AutoFilter Field:=1, Criteria1:="=" & wsTemp.Range("A" & ne).Value, Operator:=xlFilterValues
wsTemp.Range("$B:$C").ClearContents
'Copy Client Column in query table to Temp Sheet B1
que.Range("tblTS[Client]").SpecialCells(xlCellTypeVisible).Copy
wsTemp.Range("B1").PasteSpecial Paste:=xlPasteValues
'Remove Duplicate clients to result in unique clients only
wsTemp.Range("$B:$B").RemoveDuplicates Columns:=1, Header:=xlNo
'Create Dynamic Name Range for Client Names
wb.Names.Add Name:="tempClient", RefersTo:="=OFFSET(Temp!$B$1,0,0,COUNTA(Temp!$B:$B),1)"
'Set tempClient = Range("tempClient")
'Determine number of Clients for the FOR loop.
c = Range("tempClient").Count
'Begin second for loop. Second loop is for all employee names.
For nc = 1 To c
'Apply client filter to query table
que.Range("tblTS").AutoFilter Field:=6
que.Range("tblTS").AutoFilter Field:=5, Criteria1:="=" & wsTemp.Range("B" & nc).Value, Operator:=xlFilterValues
'Copy Project Column in query table to Temp Sheet C1
wsTemp.Range("$C:$C").ClearContents
que.Range("tblTS[Project Name]").SpecialCells(xlCellTypeVisible).Copy
wsTemp.Range("C1").PasteSpecial Paste:=xlPasteValues
'Remove Duplicates in the tempProject Named Range to result in unique projects only
wsTemp.Range("$C:$C").RemoveDuplicates Columns:=1, Header:=xlNo
'Create Dynamic Name Range for Project Names
wb.Names.Add Name:="tempProject", RefersTo:="=OFFSET(Temp!$C$1,0,0,COUNTA(Temp!$C:$C),1)"
'Set tempProject = Range("tempProject")
'Determine number of Clients for the FOR loop.
p = Range("tempProject").Count
'Begin third (final) for loop: Third loop is for project filtering
For np = 1 To p
'Apply Project filter to query table
If p <> 1 Then que.Range("tblTS").AutoFilter Field:=6, Criteria1:="=" & wsTemp.Range("C" & np).Value, Operator:=xlFilterValues
'Copy query table to Printout sheet
If po.Range("A3").Value <> "" Then po.AutoFilter.ShowAllData
po.Range("tblPrint").ClearContents
Range("tblTS[Date]:tblTS[Total Expenses]").SpecialCells(xlCellTypeVisible).Copy
po.Select
po.Range("A3").Select
po.Range("A3").PasteSpecial Paste:=xlPasteValues
'Filter (hide) blank cells.
po.Range("tblPrint").AutoFilter Field:=1, Criteria1:="<>"
'Print PDF to folder
po.Range("W1").NumberFormat = "#"
po.Range("W1").Value = Format(po.Range("W1").Value, "m-d-yy")
SvAs = PathName & "\PDFs\" & po.Range("D3") & "_" & po.Range("E3") & "_" & po.Range("E1") & "_" & po.Range("W1") & ".pdf"
po.ExportAsFixedFormat Type:=xlTypePDF, Filename:=SvAs, Quality:=xlQualityStandard, _
IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next 'End of third for loop
Next 'End of second for loop
Next 'End of first for loop
po.Range("A3").Select
po.AutoFilter.ShowAllData
po.Range("tblPrint").ClearContents
po.Range("E1").Value = ""
po.Range("W1").Value = ""
wsTemp.Range("$A:$C").ClearContents
wsTemp.Visible = xlSheetHidden
e = 0
c = 0
p = 0
ne = 0
nc = 0
np = 0
que.Select
que.AutoFilter.ShowAllData
Application.ScreenUpdating = True
MsgBox "Timesheets have been created at the following location:" & vbNewLine & PathName & "\PDFs", _
vbOKOnly, "Finished!"
End Sub
Eh, you would really benefit here from PowerQuery.
All the Range stuff and select and clears, I mean you need to learn how to fundamentally code with variables to improve that.
But I would say, if you're taking a table and sorting, PQ has an awesome visual editor and clickable steps that anyone, including your wife can learn.
It's a slippery slope to use VBA with your significant other, eventually, the errors and problems are going to weigh on the relationship. PQ is gonna be your Dr. Phil here and get everyone living their best life on their own.
See WillWulliems reply here about how to automate it: here

Excel PowerPivot - Working with grouped rows

I'm working on a really large excel sheet which is basically a list of users along with the applications they use. Now the problem is that there are over 60000 users with atleast 10 applications each. So its a huge sheet. 2-3 times a week I need to extract the details of the applications used by certain specific users. Sometimes it's 2 users. Sometimes its 10 users. But due to the size of the spreadsheet, this activity takes me forever (1-2 hours).
Now, the sheet is structured in the following way.
StaffId Name DeviceNo Location ApplicationCount+ AppID Application Name
12345 John Doe DSK-982333 Mespil Road 24+
123 Adobe Acrobat
234 WinZip
345 Google Chrome
The + sign here is to indicate the grouped rows.
Is there anyway for me to use PowerPivots to extract this information?
One approach would be to:
Create a copy of your spreadsheet in a new workbook.
Add another worksheet in the workbook that contains the StaffId (in column "A") of the people you want to filter for.
In the VBA editor, insert a new module and add the following code:
Sub FilterForUsersOfInterest()
Dim BigSheet As Worksheet
Dim ListSheet As Worksheet
Dim lastCell As Range
Set BigSheet = ActiveWorkbook.Sheets("ListOfApplications") 'Change the sheet name here to match your main data tab
Set ListSheet = ActiveWorkbook.Sheets("ListOfUsers") 'Change the sheet name here to match your sheet with the users of interest this time round
'Find the last used row on the worksheet
Set lastCell = BigSheet.UsedRange.Item(BigSheet.UsedRange.Cells.Count)
'Copy the values for Staff Id down all the rows
For iRow = 2 To lastCell.Row
If BigSheet.Range("A" & iRow) = "" Then
BigSheet.Range("A" & iRow) = BigSheet.Range("A" & iRow - 1)
End If
Next iRow
'Now work your way back up the rows, deleting any rows where the StaffId is not found in the current list of "users of interest"
For iRow = lastCell.Row To 2
If Application.WorksheetFunction.CountIf(ListSheet.Range("A:A"), BigSheet.Range("A" & iRow)) = 0 Then
BigSheet.Range("A" & iRow).EntireRow.Delete
End If
Next iRow
End Sub

Is it possible to change number formats of 4 columns of a row based on a text value in that row for a range of rows?

I'm in a bad spot - any help pointing me in the right direction would be helpful and much appreciated.
I've created a Access process that copies an excel file and updates it with data from 2 record sets using Copy Recordset. The process now creates 39 workbooks by copying a 'template workbook' to a new file. Each workbook will contain at least one tab, but generally contain more, one workbook has over 20 tabs.
This is all done in Access. It copies the 'template' file and then runs a loop, and using Copy Recordset copies the 'template' worksheet to each tab.
After adding the tab, it loads the data from 2 record sets into the sheet. The 1st recordset loads one row of data - no problem. However the second loads multiple rows - which can vary in number.
This all works fine. The problem is formatting columns D through G.
If Column C = Revenue, Cost or Gross Margin (GM) I want that row's columns D through G formatted as currency.
If Column C = GM% then I want columns D through G formatted as a percentage.
If column C = Hours I don't have to format it.
What I would like is to create a function that formats these columns/rows based on Column C value, when the workbook is opened. I know there is an event that fires when the workbook is opened, and I know I have looped through all of the tabs in a workbook, o I'd want to run that function for each tab.
There may be one other issue - I think I can fix that in Access, but the EAC column is being exported as text and it should numeric. Not sure right now if that's being exported as Text - or EXCEL sees it as text.
Any help would be greatly appreciated. Thanks in advance.
I have images - but it won't let me post them just yet. If they would help - let me know, I'll try to email them to you.
Bob
I've come up with a way to do it, I've included the code.
However there may be a better way - so I'm open to suggestions.
Public Sub FormatTaskRows()
Dim Sheet As Object
Dim rngTasks As Range
Dim rngFCells As Range
Dim strTaskEnd As String
Dim ix As Integer
For Each Sheet In Sheets
If Sheet.Name = "Template" Then
Sheet.Visible = xlSheetVeryHidden
Else
Sheet.Visible = xlSheetVisible
Sheet.Activate
strTaskEnd = Range("C44").End(xlDown).Address
Set rngTasks = Range("$C$44:" & strTaskEnd)
'For Each Row In rngTasks
For ix = 1 To rngTasks.Rows.Count
Sheet.Unprotect
If rngTasks.Cells(ix) = "Revenue" Or rngTasks.Cells(ix) = "Cost" Or rngTasks.Cells(ix) = "Gross Margin (GM)" Then
Set rngFCells = Range(ActiveSheet.Name & "!D" & ix + 43 & ":G" & ix + 43)
rngFCells.Select
Selection.NumberFormat = "$#,##0.00"
Else
If rngTasks.Cells(ix) = "GM%" Then
Set rngFCells = Range(ActiveSheet.Name & "!D" & ix + 43 & ":G" & ix + 43)
rngFCells.Select
Selection.NumberFormat = "0.0000%"
End If
End If
Sheet.Protect
Next ix
End If
Next
End Sub

Resources