When i try to run uniperformance to obtain data from the PHD it brings up run time error 459 stating that the object or class does not support the set of events. this is strange as the spreadsheet was working perfectly well yesterday and I have no idea what could be wrong. I have included the entire code of the spreadsheet in case it may be any use
\\VB CODE//
Sub WorkBook_Open()
'Informs user that Excel formulas need to be leghtned for Formatted Data for another Year
' change this date when formula extended
Dim dat As Date
Sheets("Current Data").Select
dat = Range("E1")
If dat > "01/12/2009" Then
MsgBox ("Formulas Need to be extended for 'Formatted Data' sheet for another year, Only Formatted Up to 01/01/2010. Please Contact Computer Student")
End If
Dim smessage As String
smessage = "You Must be Logged in with EPASS & You Must have Uniformance Open in Excel toolbar before Continuing. (Tools - Addins - Uniformance Companion for MS Excel - OK Then re-open File). PHD Must be Installed, If Not close this Document and Contact THE STUDENTS. Continue????"
If MsgBox(smessage, vbQuestion + vbYesNo, _
"Continue") = vbYes Then
Dim lastupdated As Date
Dim Today As Date
Dim B3, D3, E3, F3, G3, H3, I3, K3, L3, M3, N3 As String
Sheets("Current Data").Select
Today = Range("L1")
lastupdated = Range("E1")
If lastupdated = Today Then ' Data Up to date
MsgBox ("Data is Up To date")
Else ' have to update data
'try inserting phd tag
B3 = "=" & Range("o1")
Range("B3") = B3
D3 = "=" & Range("P1")
Range("D3") = D3
E3 = "=" & Range("Q1")
Range("E3") = E3
F3 = "=" & Range("R1")
Range("F3") = F3
G3 = "=" & Range("S1")
Range("G3") = G3
H3 = "=" & Range("T1")
Range("H3") = H3
I3 = "=" & Range("U1")
Range("I3") = I3
J3 = "=" & Range("V1")
Range("J3") = J3
K3 = "=" & Range("W1")
Range("K3") = K3
L3 = "=" & Range("X1")
Range("L3") = L3
M3 = "=" & Range("Y1")
Range("M3") = M3
Call Copy_Data
MsgBox ("Data Has Been Updated")
End If
Else
'close app
Application.Quit
End If
Call Update_Monthly_data
End Sub
Sub Update_Monthly_data()
Sheet5.Activate
Dim Start_Date As Date
Dim last_cell_used As Integer
last_cell_used = Range("A65536").End(xlUp).row
Start_Date = Range("A" & last_cell_used).Value
Start_Date = DateAdd("d", 1, Start_Date)
Dim Last_Date As Date
Dim End_Date As Date
End_Date = DateAdd("m", 1, Start_Date)
End_Date = DateAdd("d", -1, End_Date)
Dim check_Date As Integer
Dim checked_date As Date
check_Date = Range("A65536").End(xlUp).row
checked_date = Range("A" & check_Date).Value
checked_date = DateAdd("m", 1, checked_date)
If checked_date < Now() Then
Dim last_row As Integer
Dim cell As Range
Dim Dom_Water As String
Dim CoolingTower_Water As String
Dim Plant_Air As String
Dim Nitrogen_Water As String
Dim High_Pressure_Steam As String
Dim Chilled_Water As String
Dim Low_Pressure_Steam As String
Dim Low_Pressure_Condensate As String
Dim Caustic As String
Dim Instrument_Air As String
Dim Denim_Water As String
Sheet3.Activate
last_row = Range("A65536").End(xlUp).row
'search first cell address
Dim Dom_Water_Range As String
Dim CoolingTower_Water_Range As String
Dim Plant_Air_Range As String
Dim Nitrogen_Water_Range As String
Dim High_Pressure_Steam_Range As String
Dim Chilled_Water_Range As String
Dim Low_Pressure_Steam_Range As String
Dim Low_Pressure_Condensate_Range As String
Dim Caustic_Range As String
Dim Instrument_Air_Range As String
Dim Denim_Water_Range As String
Do While End_Date < Now()
'Sheet3.Activate
'find cell ref of first date
For Each b In Sheet3.Cells.Range("A1:A" & last_row)
If b.Value = Start_Date Then
Dom_Water_Range = "F" & b.row
CoolingTower_Water_Range = "G" & b.row
Plant_Air_Range = "H" & b.row
Nitrogen_Water_Range = "I" & b.row
High_Pressure_Steam_Range = "J" & b.row
Chilled_Water_Range = "K" & b.row
Low_Pressure_Steam_Range = "L" & b.row
Low_Pressure_Condensate_Range = "M" & b.row
Caustic_Range = "N" & b.row
Instrument_Air_Range = "O" & b.row
Denim_Water_Range = "P" & b.row
End If
Next b
'find end date
Sheet3.Activate
For Each r In Sheets("Formatted_Data").Cells.Range("A1:A" & last_row)
'MsgBox ("end_date is " & End_Date & "value is " & r.Value)
If r.Value = End_Date Then
'MsgBox ("r vlue is " & r.Value)
Dom_Water_Range = Dom_Water_Range & ":" & "F" & r.row
'MsgBox ("range " & Dom_Water_Range)
CoolingTower_Water_Range = CoolingTower_Water_Range & ":" & "G" & r.row
Plant_Air_Range = Plant_Air_Range & ":" & "H" & r.row
Nitrogen_Water_Range = Nitrogen_Water_Range & ":" & "I" & r.row
High_Pressure_Steam_Range = High_Pressure_Steam_Range & ":" & "J" & r.row
Chilled_Water_Range = Chilled_Water_Range & ":" & "K" & r.row
Low_Pressure_Steam_Range = Low_Pressure_Steam_Range & ":" & "L" & r.row
Low_Pressure_Condensate_Range = Low_Pressure_Condensate_Range & ":" & "M" & r.row
Caustic_Range = Caustic_Range & ":" & "N" & r.row
Instrument_Air_Range = Instrument_Air_Range & ":" & "O" & r.row
Denim_Water_Range = Denim_Water_Range & ":" & "P" & r.row
End If
'MsgBox ("r vlue is " & End_Date)
Next r
'get sum of range for each each category
'Sheet3.Activate
Dom_Water = Application.WorksheetFunction.Sum(Range([Dom_Water_Range]))
CoolingTower_Water = Application.WorksheetFunction.Sum(Range([CoolingTower_Water_Range]))
Plant_Air = Application.WorksheetFunction.Sum(Range([Plant_Air_Range]))
Nitrogen_Water = Application.WorksheetFunction.Sum(Range([Nitrogen_Water_Range]))
High_Pressure_Steam = Application.WorksheetFunction.Sum(Range([High_Pressure_Steam_Range]))
Chilled_Water = Application.WorksheetFunction.Sum(Range([Chilled_Water_Range]))
Low_Pressure_Steam = Application.WorksheetFunction.Sum(Range([Low_Pressure_Steam_Range]))
Low_Pressure_Condensate = Application.WorksheetFunction.Sum(Range([Low_Pressure_Condensate_Range]))
Caustic = Application.WorksheetFunction.Sum(Range([Caustic_Range]))
Instrument_Air = Application.WorksheetFunction.Sum(Range([Instrument_Air_Range]))
Denim_Water = Application.WorksheetFunction.Sum(Range([Denim_Water_Range]))
'write sum to next line on monthly datasheet
Sheet5.Activate
Dim next_month As Integer
Dim next_Dom_Water As Integer
'sorts date in date column
next_month = Range("A65536").End(xlUp).row + 1
Range("A" & next_month).Value = End_Date
Range("B" & next_month).Value = End_Date
Range("A" & next_month).NumberFormat = "mmm yyyy"
'Range("B" & next_month).NumberFormat = "yyyy"
'sorts date so that only year is in column - inserts formula into cell
Dim sort_Date As String
Range("B" & next_month).Value = "=(TRUNC(YEAR(" & ("A" & next_month) & ")))"
'puts sums in relevant columns
next_Dom_Water = Range("B65536").End(xlUp).row
Range("C" & next_Dom_Water).Value = Dom_Water
Range("D" & next_Dom_Water).Value = CoolingTower_Water
Range("E" & next_Dom_Water).Value = Plant_Air
Range("F" & next_Dom_Water).Value = Nitrogen_Water
Range("G" & next_Dom_Water).Value = High_Pressure_Steam
Range("H" & next_Dom_Water).Value = Chilled_Water
Range("I" & next_Dom_Water).Value = Low_Pressure_Steam
Range("J" & next_Dom_Water).Value = Low_Pressure_Condensate
Range("K" & next_Dom_Water).Value = Caustic
Range("L" & next_Dom_Water).Value = Instrument_Air
Range("M" & next_Dom_Water).Value = Denim_Water
Start_Date = DateAdd("m", 1, Start_Date)
End_Date = DateAdd("m", 1, End_Date)
Loop
End If
End Sub
\\VB CODE//
Sub WorkBook_Open()
'Informs user that Excel formulas need to be leghtned for Formatted Data for another Year
' change this date when formula extended
Dim dat As Date
Sheets("Current Data").Select
dat = Range("E1")
If dat > "01/12/2009" Then
MsgBox ("Formulas Need to be extended for 'Formatted Data' sheet for another year, Only Formatted Up to 01/01/2010. Please Contact Computer Student")
End If
Dim smessage As String
smessage = "You Must be Logged in with EPASS & You Must have Uniformance Open in Excel toolbar before Continuing. (Tools - Addins - Uniformance Companion for MS Excel - OK Then re-open File). PHD Must be Installed, If Not close this Document and Contact THE STUDENTS. Continue????"
If MsgBox(smessage, vbQuestion + vbYesNo, _
"Continue") = vbYes Then
Dim lastupdated As Date
Dim Today As Date
Dim B3, D3, E3, F3, G3, H3, I3, K3, L3, M3, N3 As String
Sheets("Current Data").Select
Today = Range("L1")
lastupdated = Range("E1")
If lastupdated = Today Then ' Data Up to date
MsgBox ("Data is Up To date")
Else ' have to update data
'try inserting phd tag
B3 = "=" & Range("o1")
Range("B3") = B3
D3 = "=" & Range("P1")
Range("D3") = D3
E3 = "=" & Range("Q1")
Range("E3") = E3
F3 = "=" & Range("R1")
Range("F3") = F3
G3 = "=" & Range("S1")
Range("G3") = G3
H3 = "=" & Range("T1")
Range("H3") = H3
I3 = "=" & Range("U1")
Range("I3") = I3
J3 = "=" & Range("V1")
Range("J3") = J3
K3 = "=" & Range("W1")
Range("K3") = K3
L3 = "=" & Range("X1")
Range("L3") = L3
M3 = "=" & Range("Y1")
Range("M3") = M3
Call Copy_Data
MsgBox ("Data Has Been Updated")
End If
Else
'close app
Application.Quit
End If
Call Update_Monthly_data
End Sub
Sub Update_Monthly_data()
Sheet5.Activate
Dim Start_Date As Date
Dim last_cell_used As Integer
last_cell_used = Range("A65536").End(xlUp).row
Start_Date = Range("A" & last_cell_used).Value
Start_Date = DateAdd("d", 1, Start_Date)
Dim Last_Date As Date
Dim End_Date As Date
End_Date = DateAdd("m", 1, Start_Date)
End_Date = DateAdd("d", -1, End_Date)
Dim check_Date As Integer
Dim checked_date As Date
check_Date = Range("A65536").End(xlUp).row
checked_date = Range("A" & check_Date).Value
checked_date = DateAdd("m", 1, checked_date)
If checked_date < Now() Then
Dim last_row As Integer
Dim cell As Range
Dim Dom_Water As String
Dim CoolingTower_Water As String
Dim Plant_Air As String
Dim Nitrogen_Water As String
Dim High_Pressure_Steam As String
Dim Chilled_Water As String
Dim Low_Pressure_Steam As String
Dim Low_Pressure_Condensate As String
Dim Caustic As String
Dim Instrument_Air As String
Dim Denim_Water As String
Sheet3.Activate
last_row = Range("A65536").End(xlUp).row
'search first cell address
Dim Dom_Water_Range As String
Dim CoolingTower_Water_Range As String
Dim Plant_Air_Range As String
Dim Nitrogen_Water_Range As String
Dim High_Pressure_Steam_Range As String
Dim Chilled_Water_Range As String
Dim Low_Pressure_Steam_Range As String
Dim Low_Pressure_Condensate_Range As String
Dim Caustic_Range As String
Dim Instrument_Air_Range As String
Dim Denim_Water_Range As String
Do While End_Date < Now()
'Sheet3.Activate
'find cell ref of first date
For Each b In Sheet3.Cells.Range("A1:A" & last_row)
If b.Value = Start_Date Then
Dom_Water_Range = "F" & b.row
CoolingTower_Water_Range = "G" & b.row
Plant_Air_Range = "H" & b.row
Nitrogen_Water_Range = "I" & b.row
High_Pressure_Steam_Range = "J" & b.row
Chilled_Water_Range = "K" & b.row
Low_Pressure_Steam_Range = "L" & b.row
Low_Pressure_Condensate_Range = "M" & b.row
Caustic_Range = "N" & b.row
Instrument_Air_Range = "O" & b.row
Denim_Water_Range = "P" & b.row
End If
Next b
'find end date
Sheet3.Activate
For Each r In Sheets("Formatted_Data").Cells.Range("A1:A" & last_row)
'MsgBox ("end_date is " & End_Date & "value is " & r.Value)
If r.Value = End_Date Then
'MsgBox ("r vlue is " & r.Value)
Dom_Water_Range = Dom_Water_Range & ":" & "F" & r.row
'MsgBox ("range " & Dom_Water_Range)
CoolingTower_Water_Range = CoolingTower_Water_Range & ":" & "G" & r.row
Plant_Air_Range = Plant_Air_Range & ":" & "H" & r.row
Nitrogen_Water_Range = Nitrogen_Water_Range & ":" & "I" & r.row
High_Pressure_Steam_Range = High_Pressure_Steam_Range & ":" & "J" & r.row
Chilled_Water_Range = Chilled_Water_Range & ":" & "K" & r.row
Low_Pressure_Steam_Range = Low_Pressure_Steam_Range & ":" & "L" & r.row
Low_Pressure_Condensate_Range = Low_Pressure_Condensate_Range & ":" & "M" & r.row
Caustic_Range = Caustic_Range & ":" & "N" & r.row
Instrument_Air_Range = Instrument_Air_Range & ":" & "O" & r.row
Denim_Water_Range = Denim_Water_Range & ":" & "P" & r.row
End If
'MsgBox ("r vlue is " & End_Date)
Next r
'get sum of range for each each category
'Sheet3.Activate
Dom_Water = Application.WorksheetFunction.Sum(Range([Dom_Water_Range]))
CoolingTower_Water = Application.WorksheetFunction.Sum(Range([CoolingTower_Water_Range]))
Plant_Air = Application.WorksheetFunction.Sum(Range([Plant_Air_Range]))
Nitrogen_Water = Application.WorksheetFunction.Sum(Range([Nitrogen_Water_Range]))
High_Pressure_Steam = Application.WorksheetFunction.Sum(Range([High_Pressure_Steam_Range]))
Chilled_Water = Application.WorksheetFunction.Sum(Range([Chilled_Water_Range]))
Low_Pressure_Steam = Application.WorksheetFunction.Sum(Range([Low_Pressure_Steam_Range]))
Low_Pressure_Condensate = Application.WorksheetFunction.Sum(Range([Low_Pressure_Condensate_Range]))
Caustic = Application.WorksheetFunction.Sum(Range([Caustic_Range]))
Instrument_Air = Application.WorksheetFunction.Sum(Range([Instrument_Air_Range]))
Denim_Water = Application.WorksheetFunction.Sum(Range([Denim_Water_Range]))
'write sum to next line on monthly datasheet
Sheet5.Activate
Dim next_month As Integer
Dim next_Dom_Water As Integer
'sorts date in date column
next_month = Range("A65536").End(xlUp).row + 1
Range("A" & next_month).Value = End_Date
Range("B" & next_month).Value = End_Date
Range("A" & next_month).NumberFormat = "mmm yyyy"
'Range("B" & next_month).NumberFormat = "yyyy"
'sorts date so that only year is in column - inserts formula into cell
Dim sort_Date As String
Range("B" & next_month).Value = "=(TRUNC(YEAR(" & ("A" & next_month) & ")))"
'puts sums in relevant columns
next_Dom_Water = Range("B65536").End(xlUp).row
Range("C" & next_Dom_Water).Value = Dom_Water
Range("D" & next_Dom_Water).Value = CoolingTower_Water
Range("E" & next_Dom_Water).Value = Plant_Air
Range("F" & next_Dom_Water).Value = Nitrogen_Water
Range("G" & next_Dom_Water).Value = High_Pressure_Steam
Range("H" & next_Dom_Water).Value = Chilled_Water
Range("I" & next_Dom_Water).Value = Low_Pressure_Steam
Range("J" & next_Dom_Water).Value = Low_Pressure_Condensate
Range("K" & next_Dom_Water).Value = Caustic
Range("L" & next_Dom_Water).Value = Instrument_Air
Range("M" & next_Dom_Water).Value = Denim_Water
Start_Date = DateAdd("m", 1, Start_Date)
End_Date = DateAdd("m", 1, End_Date)
Loop
End If
End Sub
