jk_12
asked on
Automate Reporting in Excel
Hello,
The below code is used to automate a 1 sheet report in excel. The code cycles through a list of names, and generates a unique report for each name.
I would like to add a second sheet, however, I'm not sure where to begin. This was written by someone who no longer works with me.
Thank you for your help.
jk
The below code is used to automate a 1 sheet report in excel. The code cycles through a list of names, and generates a unique report for each name.
I would like to add a second sheet, however, I'm not sure where to begin. This was written by someone who no longer works with me.
Thank you for your help.
jk
Dim objSheet As Worksheet
Dim wks_array_eng() As Single
Dim wks_array_frf() As Single
Private Sub CommandButton_RunReports_Click()
Application.DisplayAlerts = False
Call fill_wks_array_eng
Call fill_wks_array_frf
transitlist.Activate
transitlist.Range("A3").Activate
Call run_transit(1)
End Sub
Private Sub run_transit(intcol1 As Integer)
For Each c In ActiveCell.CurrentRegion.Cells
If c.Column = intcol1 Then
strReportTransit = Trim(c)
Set objSheet = hierarchypull
objSheet.Range("A2").Value = c
TextBox_transitname.Value = CStr(hierarchypull.Range("A4").Value)
Call OutputToFile(wks_array_eng, "E")
End If
Next
Application.DisplayAlerts = True
MsgBox ("Done")
control.Activate
End Sub
Public Sub OutputToFile(wks_array() As Single, rpt_lang As String)
Dim filename As String
Dim temp_num_sheets As Integer
Dim temp_indx As Integer
Select Case rpt_lang
Case "E"
filename = "Report Jan31,2011 - " & Trim(TextBox_transitname.Value) & " District" & " .xls"
End Select
Sheets(wks_array).Select
ActiveWindow.SelectedSheets.Copy
temp_num_sheets = Worksheets.Count
For temp_indx = 1 To temp_num_sheets
Sheets(temp_indx).Activate
ActiveSheet.Range("A1:CA2000").Copy
ActiveSheet.Range("A1:CA2000").PasteSpecial Paste:=xlPasteValues
ActiveSheet.Protect Password:="asdf", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.Range("C1").Select
Next temp_indx
ActiveWorkbook.Colors(38) = RGB(59, 90, 111)
ActiveWorkbook.Colors(39) = RGB(234, 234, 234)
Sheets(1).Activate
'ActiveSheet.Protect Password:="asdf", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.SaveAs "C:\temp\" & filename
Workbooks(filename).Close SaveChanges:=False
End Sub
Private Sub TextBox_transitname_Change()
End Sub
Public Sub fill_wks_array_eng()
Dim start_wks_indx As Integer
Dim end_wks_indx As Integer
Dim ArraySize As Integer
Dim counter As Integer
Dim array_indx As Integer
start_wks_indx = eng_reports.Index + 1
end_wks_indx = frf_reports.Index - 1
ArraySize = end_wks_indx - start_wks_indx
ReDim wks_array_eng(ArraySize)
array_indx = 0
For counter = start_wks_indx To end_wks_indx
wks_array_eng(array_indx) = counter
array_indx = array_indx + 1
Next
End Sub
Public Sub fill_wks_array_frf()
Dim start_wks_indx As Integer
Dim end_wks_indx As Integer
Dim ArraySize As Integer
Dim counter As Integer
Dim array_indx As Integer
start_wks_indx = frf_reports.Index + 1
end_wks_indx = data.Index - 1
ArraySize = end_wks_indx - start_wks_indx
ReDim wks_array_frf(ArraySize)
array_indx = 0
For counter = start_wks_indx To end_wks_indx
wks_array_frf(array_indx) = counter
array_indx = array_indx + 1
Next
End Sub
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER