My work uses a macro with one specific file that seems to work on every computer but mine. When I run the macro, I get the Run-time error '06 overflow message. When I use the debug option, it brings me to a part of the code that shows " x = x + 1". As I've said, this macro will work on the same file on a different computer with no errors. I have no VBA experience and I am using Excel 2010, and my security setting is set so that I can run any macro (lowest security level). The macro is below:
Code:
Sub Temp_Hours_Report()
'
' Macro1 Macro
' Macro recorded 3/25/2010 by Jason Feil
'
Dim x As Integer 'row number counter
Dim EEHours As Double
Dim TodayDate As String
TodayDate = Mid(Range("b2").Value, 14, 99)
Dim StartRow As Integer
Dim KerryDept As String
'Unmerge all cells
Cells.Select
With Selection
.WrapText = False
.MergeCells = False
End With
'Add date column
Columns("D:D").Select
Selection.Insert Shift:=xlToRight
Range("D17").Select
Columns("A:A").Delete
'Delete data rows not containing agency name
x = 1
Dim AgencyName As String 'To hold agency name used to identify agency employees
AgencyName = "Adecco"
Dim BlankRows As Integer
BlankRows = 0
'Find first row of Employee Data
Do Until Range("B" & x).Value = "ID"
If Range("B" & x).Value = "ID" Then
Else
x = x + 1
End If
Loop
StartRow = x
Range("C" & StartRow).Value = "Date"
If Range("D" & x).Value = "" Then
Range("D:D").Delete
End If
' Range("Q" & x).Value = "Hours"
' Range("Q" & x).Interior.ColorIndex = 15
' Range("Q" & x).HorizontalAlignment = xlRight
' Range("Q" & x).Font.Size = 9
x = x + 1
'Delete non-agency names
Do Until BlankRows = 40
If Left(Range("A" & x).Value, 6) = AgencyName Then 'Temp associate
'Add hours format conversion
EEHours = Left(Range("I" & x).Value, InStr(Range("I" & x).Value, ":") - 1) + Right(Range("I" & x).Value, 2) / 60
Range("I" & x).Value = EEHours
Range("I" & x).NumberFormat = "#,##0.00"
Range("C" & x).Value = TodayDate
'Add Kerry Dept column
If InStr(Range("D" & x).Value, "/") = "6" Then
KerryDept = Mid(Range("D" & x).Value, 15, 4)
Else
KerryDept = Mid(Range("D" & x).Value, 16, 4)
End If
Range("D" & x).NumberFormat = "@"
Range("D" & x).Value = KerryDept
x = x + 1
ElseIf Range("A" & x).Value = "" Then 'blank row
BlankRows = BlankRows + 1
Selection.EntireRow.Delete
Else 'Not temp associate
Range("A" & x).Select
Selection.EntireRow.Delete
End If
Loop
'Delete all header information
x = 1
Do Until Range("B" & x).Value = "ID"
If Range("B" & x).Value = "ID" Then
Else
Range("B" & x).EntireRow.Delete
End If
Loop
'Delete extra columns
Range("E:E").Delete
Range("E:E").Delete
Range("E:E").Delete
Range("E:E").Delete
Range("F:F").Delete
Range("F:F").Delete
End Sub
Last edited: