Create/Open File & Looping problem (Long Code Sample)

benallen002 · Jun 29, 2006

Hey guys,

This thing has got me really stumped and I haven't been able to figure a way past it yet, so I thought I would ask the experts. I created this procedure that uses 3 or 4 loops to pull a bunch of information from different places on one worksheet and put them in order on another sheet. The goal then was to copy the second sheet out of the workbook where it started and into another workbook. What I want it to do is if it can't find the file that it is supposed to go to, then it creates the file right there and then pastes the sheet in. I got this to work great if I go one sheet at a time, but what I'm trying to do is create one final loop that would automate it for me. Like I said all the code works great the first time through, but when it goes back the second time (or 3rd or 4th), I get different errors all the time, depending on where I've put 1) the final Loop call and 2) the Error Handler that creates a new workbook if one is not there. Anyways, like I said, I can't seem to figure out the right order that the final loop code and Error code need to go in. Any help you guys could offer would be greatly appreciated. I'll paste my code below...



Sub ReportNamesAndClassesDailySheet()

' Declare the variables used in the routine
Dim OutputRow As Integer
Dim InputRow As Integer
Dim LastRow As Integer
Dim OutputFile As String
Dim strSaveName As String
Dim JobFile As String
Dim ThisSheet As String
Dim NewFile As String
Dim ChargeInt As Integer
Dim CostInt As Integer
Dim LastRow2 As Integer
Dim TaskRow As Integer
Dim LastCol As Integer
Dim TaskCol As Integer
Dim LoopInt As Integer
Dim StartRow As Integer
Dim StartCol As Integer
Dim RepShift As String
Dim RepDay As String
Dim RepWkenMon As String
Dim RepWkenDay As String
Dim RepWkenYear As String
Dim TaskName As String
Dim FilePath As String
Dim ReportPath As String

' Sets the folder that the Save As dialog box defaults to at the end of this routine
ChDir Application.ActiveWorkbook.Path + "\Task Reports"

' Sets the path for the folders used in this routine
FilePath = Application.ActiveWorkbook.Path
ReportPath = Application.ActiveWorkbook.Path + "\Task Reports"

' Sets the string for the workbook name and active sheet
JobFile = Application.ActiveWorkbook.Name
ThisSheet = Application.ActiveWorkbook.ActiveSheet.Name

' Doesn't really work that well with this routine
Application.ScreenUpdating = False

On Error Resume Next

' Get report info. & name from user and store as string
RepShift = cboxShift.Text
RepDay = cboxDay.Text
RepWkenMon = calWkend.Month
RepWkenDay = calWkend.Day
RepWkenYear = calWkend.Year

strSaveName = RepShift + " WKEND " + RepWkenMon + "-" + RepWkenDay + "-" + RepWkenYear + " " + RepDay

' Adds the total hours from all employees & all tasks
' Call AddTotalsRow

' Compute rows and columnes in worksheet and assign to variables
LastRow = Workbooks(JobFile).Worksheets(ThisSheet).UsedRange.Rows.Count
LastCol = Workbooks(JobFile).Worksheets(ThisSheet).UsedRange.Columns.Count

' Set the start point for these variables used in the loops
OutputRow = 2
InputRow = 2
StartCol = 8

' Gives the first file it's name
TaskName = Workbooks(JobFile).Worksheets(ThisSheet).Cells(1, StartCol).Value

Start:

Do While StartCol <= LastCol

' Add Names, Employee #s and Classes to blank timesheet
ActiveWorkbook.Worksheets("DailyTimeReport (Blank)").Activate

Do While OutputRow <= LastRow

Range("A" & InputRow).Select

'Format each row
Call FormatRowDaily

Range("A" & InputRow).Value = Workbooks(JobFile).Worksheets(ThisSheet).Range("A" & OutputRow).Value
Range("B" & InputRow).Value = Workbooks(JobFile).Worksheets(ThisSheet).Range("D" & OutputRow).Value
Range("F" & InputRow).Value = Workbooks(JobFile).Worksheets(ThisSheet).Range("E" & OutputRow).Value

InputRow = InputRow + 3
OutputRow = OutputRow + 3

Range("B" & InputRow).Activate

Loop

' Reset for next loop
OutputRow = 2
InputRow = 2

'Add the days hours
Do While OutputRow <= LastRow

 Range("H" & InputRow).Value = Workbooks(JobFile).Worksheets(ThisSheet).Cells(OutputRow, StartCol).Value

 InputRow = InputRow + 1
 OutputRow = OutputRow + 1

 Range("B" & InputRow).Activate

Loop

' Reset for next loop
OutputRow = 2
InputRow = 2

' Adds the rates; first charge, then cost
Do While OutputRow <= LastRow

ChargeInt = 3
CostInt = 13

Do While ChargeInt <= 5

 Range("I" & InputRow).Value = "=vlookup(F" & OutputRow & ",ChargeRates," & ChargeInt & ",False)"
 Range("L" & InputRow).Value = "=vlookup(B" & OutputRow & ",Employee_List," & CostInt & ",False)"

 ' Sets the format to "Accounting"
 Range("I" & InputRow).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
 Range("L" & InputRow).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"

 ' Formats the grey columns of the sheet
 Range("K" & InputRow).Select
 With Selection.Interior
 .ColorIndex = 15
 .Pattern = xlSolid
 End With

 Range("N" & InputRow).Select
 With Selection.Interior
 .ColorIndex = 15
 .Pattern = xlSolid
 End With

 Range("Q" & InputRow).Select
 With Selection.Interior
 .ColorIndex = 15
 .Pattern = xlSolid
 End With

 Range("S" & InputRow).Select
 With Selection.Interior
 .ColorIndex = 15
 .Pattern = xlSolid
 End With

 ' Moves down to next name
 InputRow = InputRow + 1
 ChargeInt = ChargeInt + 1
 CostInt = CostInt + 1

 Range("B" & InputRow).Activate

Loop

OutputRow = OutputRow + 3

Loop

' Reset for next loop
OutputRow = 2
InputRow = 2

' Adds the extensions; first charge, then cost
Do While OutputRow <= LastRow

 Range("J" & InputRow).Value = "=I" & OutputRow & "*H" & OutputRow & ""
 Range("M" & InputRow).Value = "=L" & OutputRow & "*H" & OutputRow & ""

 ' Sets the format to "Accounting"
 Range("J" & InputRow).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
 Range("M" & InputRow).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"

InputRow = InputRow + 1
OutputRow = OutputRow + 1

Range("B" & InputRow).Activate

Loop

' Reset for next loop
OutputRow = 2
InputRow = 2

' Adds the totals for charge then cost rates
Range("O2").Value = "=sum(J:J)"
Range("O2").NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
Range("P2").Value = "=sum(M:M)"
Range("P2").NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
Range("R2").Value = "=O2-P2"
Range("R2").NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
Range("T2").Value = "=sum(H:H)"

' Removes the Total row from the copied sheet to avoid #N/A formulas on the sheet
' due too bad lookups
LoopInt = 1

 Do While LoopInt <= 4

 Rows(LastRow).Select
 Selection.Delete Shift:=xlUp

 LoopInt = LoopInt + 1
 LastRow = LastRow - 1

 Loop

' Resets these two values for the next loop
LoopInt = 1
LastRow = Workbooks(JobFile).Worksheets(ThisSheet).UsedRange.Rows.Count

' This removes all the formulas and leaves just values to copy to the new sheet
Call RemoveFormulasWorksheet

' Opens the task's workbook (based on the TaskName value), if it can't find the file
' to open, the Error handling code creates it
On Error GoTo HandleError

ChDir ReportPath
 Workbooks.Open Filename:= _
 ReportPath + "\" + TaskName + ".xls"
 Windows(JobFile).Activate
 Sheets("DailyTimeReport (Blank)").Select
 Sheets("DailyTimeReport (Blank)").Copy After:=Workbooks( _
 TaskName).Sheets(1)

' Changes the name of the new sheet to the user inputed text from beginning of routine
Application.ActiveWorkbook.ActiveSheet.Name = strSaveName

' Resets the "DailyTimeReport (Blank)" page by deleting all rows except for header
Application.Workbooks(JobFile).Worksheets("DailyTimeReport (Blank)").Activate

Rows("2:10000").Select
 Range("G2").Activate
 Selection.Delete Shift:=xlUp
 Range("A1").Select

' Moves to the next task on the page for the next loop
StartCol = StartCol + 1

' Assigns that task's name to the TaskName string variable
TaskName = Workbooks(JobFile).Worksheets(ThisSheet).Cells(1, StartCol).Value

HandleError:

Set NewBook = Workbooks.Add(ReportPath + "\TaskReportTemplate.xls")
 With NewBook
 .SaveAs Filename:=ReportPath + "\" + TaskName + ".xls"
 End With

GoTo Start

Exit Sub

Loop

Application.ScreenUpdating = True

' Resets the default path to the main folder where the application runs
ChDir Workbooks(JobFile).Path

End Sub

benallen002 · Jun 29, 2006

Sub ReportNamesAndClassesDailySheet()

' Declare the variables used in the routine
Dim OutputRow As Integer
Dim InputRow As Integer
Dim LastRow As Integer
Dim OutputFile As String
Dim strSaveName As String
Dim JobFile As String
Dim ThisSheet As String
Dim NewFile As String
Dim ChargeInt As Integer
Dim CostInt As Integer
Dim LastRow2 As Integer
Dim TaskRow As Integer
Dim LastCol As Integer
Dim TaskCol As Integer
Dim LoopInt As Integer
Dim StartRow As Integer
Dim StartCol As Integer
Dim RepShift As String
Dim RepDay As String
Dim RepWkenMon As String
Dim RepWkenDay As String
Dim RepWkenYear As String
Dim TaskName As String
Dim FilePath As String
Dim ReportPath As String

' Sets the folder that the Save As dialog box defaults to at the end of this routine
ChDir Application.ActiveWorkbook.Path + "\Task Reports"

' Sets the path for the folders used in this routine
FilePath = Application.ActiveWorkbook.Path
ReportPath = Application.ActiveWorkbook.Path + "\Task Reports"

' Sets the string for the workbook name and active sheet
JobFile = Application.ActiveWorkbook.Name
ThisSheet = Application.ActiveWorkbook.ActiveSheet.Name

' Doesn't really work that well with this routine
Application.ScreenUpdating = False

On Error Resume Next

' Get report info. & name from user and store as string
RepShift = cboxShift.Text
RepDay = cboxDay.Text
RepWkenMon = calWkend.Month
RepWkenDay = calWkend.Day
RepWkenYear = calWkend.Year

strSaveName = RepShift + " WKEND " + RepWkenMon + "-" + RepWkenDay + "-" + RepWkenYear + " " + RepDay

' Adds the total hours from all employees & all tasks
' Call AddTotalsRow

' Compute rows and columnes in worksheet and assign to variables
LastRow = Workbooks(JobFile).Worksheets(ThisSheet).UsedRange.Rows.Count
LastCol = Workbooks(JobFile).Worksheets(ThisSheet).UsedRange.Columns.Count

' Set the start point for these variables used in the loops
OutputRow = 2
InputRow = 2
StartCol = 8

' Gives the first file it's name
TaskName = Workbooks(JobFile).Worksheets(ThisSheet).Cells(1, StartCol).Value

Start:

Do While StartCol <= LastCol

' Add Names, Employee #s and Classes to blank timesheet
ActiveWorkbook.Worksheets("DailyTimeReport (Blank)").Activate

Do While OutputRow <= LastRow

Range("A" & InputRow).Select

'Format each row
Call FormatRowDaily

Range("A" & InputRow).Value = Workbooks(JobFile).Worksheets(ThisSheet).Range("A" & OutputRow).Value
Range("B" & InputRow).Value = Workbooks(JobFile).Worksheets(ThisSheet).Range("D" & OutputRow).Value
Range("F" & InputRow).Value = Workbooks(JobFile).Worksheets(ThisSheet).Range("E" & OutputRow).Value

InputRow = InputRow + 3
OutputRow = OutputRow + 3

Range("B" & InputRow).Activate

Loop

' Reset for next loop
OutputRow = 2
InputRow = 2

'Add the days hours
Do While OutputRow <= LastRow

Range("H" & InputRow).Value = Workbooks(JobFile).Worksheets(ThisSheet).Cells(OutputRow, StartCol).Value

InputRow = InputRow + 1
OutputRow = OutputRow + 1

Range("B" & InputRow).Activate

Loop

' Reset for next loop
OutputRow = 2
InputRow = 2

' Adds the rates; first charge, then cost
Do While OutputRow <= LastRow

ChargeInt = 3
CostInt = 13

Do While ChargeInt <= 5

Range("I" & InputRow).Value = "=vlookup(F" & OutputRow & ",ChargeRates," & ChargeInt & ",False)"
Range("L" & InputRow).Value = "=vlookup(B" & OutputRow & ",Employee_List," & CostInt & ",False)"

' Sets the format to "Accounting"
Range("I" & InputRow).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
Range("L" & InputRow).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"

' Formats the grey columns of the sheet
Range("K" & InputRow).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With

Range("N" & InputRow).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With

Range("Q" & InputRow).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With

Range("S" & InputRow).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With

' Moves down to next name
InputRow = InputRow + 1
ChargeInt = ChargeInt + 1
CostInt = CostInt + 1

Range("B" & InputRow).Activate

Loop

OutputRow = OutputRow + 3

Loop

' Reset for next loop
OutputRow = 2
InputRow = 2

' Adds the extensions; first charge, then cost
Do While OutputRow <= LastRow

Range("J" & InputRow).Value = "=I" & OutputRow & "*H" & OutputRow & ""
Range("M" & InputRow).Value = "=L" & OutputRow & "*H" & OutputRow & ""

' Sets the format to "Accounting"
Range("J" & InputRow).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
Range("M" & InputRow).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"

InputRow = InputRow + 1
OutputRow = OutputRow + 1

Range("B" & InputRow).Activate

Loop

' Reset for next loop
OutputRow = 2
InputRow = 2

' Adds the totals for charge then cost rates
Range("O2").Value = "=sum(J:J)"
Range("O2").NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
Range("P2").Value = "=sum(M:M)"
Range("P2").NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
Range("R2").Value = "=O2-P2"
Range("R2").NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
Range("T2").Value = "=sum(H:H)"

' Removes the Total row from the copied sheet to avoid #N/A formulas on the sheet
' due too bad lookups
LoopInt = 1

Do While LoopInt <= 4

Rows(LastRow).Select
Selection.Delete Shift:=xlUp

LoopInt = LoopInt + 1
LastRow = LastRow - 1

Loop

' Resets these two values for the next loop
LoopInt = 1
LastRow = Workbooks(JobFile).Worksheets(ThisSheet).UsedRange.Rows.Count

' This removes all the formulas and leaves just values to copy to the new sheet
Call RemoveFormulasWorksheet

' Opens the task's workbook (based on the TaskName value), if it can't find the file
' to open, the Error handling code creates it
On Error GoTo HandleError

ChDir ReportPath
Workbooks.Open Filename:= _
ReportPath + "\" + TaskName + ".xls"
Windows(JobFile).Activate
Sheets("DailyTimeReport (Blank)").Select
Sheets("DailyTimeReport (Blank)").Copy After:=Workbooks( _
TaskName).Sheets(1)

' Changes the name of the new sheet to the user inputed text from beginning of routine
Application.ActiveWorkbook.ActiveSheet.Name = strSaveName

' Resets the "DailyTimeReport (Blank)" page by deleting all rows except for header
Application.Workbooks(JobFile).Worksheets("DailyTimeReport (Blank)").Activate

Rows("2:10000").Select
Range("G2").Activate
Selection.Delete Shift:=xlUp
Range("A1").Select

' Moves to the next task on the page for the next loop
StartCol = StartCol + 1

' Assigns that task's name to the TaskName string variable
TaskName = Workbooks(JobFile).Worksheets(ThisSheet).Cells(1, StartCol).Value

HandleError:

Set NewBook = Workbooks.Add(ReportPath + "\TaskReportTemplate.xls")
With NewBook
.SaveAs Filename:=ReportPath + "\" + TaskName + ".xls"
End With

GoTo Start

Exit Sub

Loop

Application.ScreenUpdating = True

' Resets the default path to the main folder where the application runs
ChDir Workbooks(JobFile).Path

End Sub

Create/Open File & Looping problem (Long Code Sample)

benallen002

Board Regular

benallen002

Board Regular

Similar threads

Share this page

Create/Open File & Looping problem (Long Code Sample)

benallen002

Board Regular

benallen002

Board Regular

Similar threads

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock