• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 197
  • Last Modified:

Excel VB code isn't working

I have a spreadsheet that I have done some VB code in it.  Over the past couple of weeks the codes have stopped working.  It was suggested that I look for *.exd files delete them and that would resolve my problem.  It did the first time but now I keep getting these two files MSForms.exd and RefEdit.exd that pop up each time I open my database.  I delete them multiple times and ever time I open the database these keep occurring.  Once I delete them and then open the database and I get a runtime error of 32809, application-defined or object defined error.    I had never had this issue before.  When I debug it I see that I had put some code in "ThisWORKBOOK" that basically called up the Home page as I wanted users who open the workbook to get the home page which has some button navigation on it for them.  The code says that   Sheets("Home").Activate  is where the issue resides, but this has worked for the last 5 months without issue.  I have checked to make sure that  under Macro security Enable all macros is selected but none of my code works now.  But none of my macros work now.    I tried uploading the file but it tells me that a virus was detected in the uploaded file.  How do I scan the file and fix or remove it.  I am on a locked odwon PC and have win7 and office 2010.  Can anyone help me here?
0
Rrave26
Asked:
Rrave26
  • 17
  • 5
  • 4
  • +1
1 Solution
 
NorieCommented:
How does the code not work?

Are you getting errors or is just not working?
0
 
Rrave26Author Commented:
I get a runtime error of 32809, application-defined or object defined error and then most of the code simply isn't working.
0
 
Martin LissRetired ProgrammerCommented:
now I keep getting these two files MSForms.exd and RefEdit.exd that pop up each time I open my database
What do you mean when you say they pop up?

Can you attach your workbook?
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
James ElliottCommented:
The .exd issue refers to a windows update released at the end of last year which screwed up a load of active-x libraries.

Here's a link. See if it solves your problem.

http://stackoverflow.com/questions/27411399/microsoft-excel-activex-controls-disabled


If not you're going to have to (at least) post your code, and preferably, upload your entire workbook.

Ta
0
 
Martin LissRetired ProgrammerCommented:
When you say
I tried uploading the file but it tells me that a virus was detected in the uploaded file.
 
do you mean you tried uploading it to Experts-Exchange?
0
 
Rrave26Author Commented:
When I open the database I notice my VB code doesn't work.  In a previous question I asked the same question and I as told to look for *.exd files, delete them and then the code should work.  So  have been doing that and I have noticed that MSForms.exd and RefEdit.exd show up when I search my C: for them.  I delete them, go back into the database and then get the run time error and the VB code doesn't work.  

I have tried to attach my spreadsheet but when I try to upload it, I am told that it has a virus and wont let me upload it.  How do I check my file for virus's?
0
 
NorieCommented:
How is the workbook being opened?
0
 
Rrave26Author Commented:
Yes I can't upload it to experts exchange.
0
 
James ElliottCommented:
@Rrave26 - are you using the words 'spreadsheet' and 'database' interchangeably, or does this issue in fact affect both a spreadsheet, and a database?
0
 
Rrave26Author Commented:
It is an excel spreadsheet James.  My apologies.
0
 
Martin LissRetired ProgrammerCommented:
Do you have anti-virus software? If so which one? When you were told that you had a virus, did you try to remove it?
0
 
James ElliottCommented:
Open your spreadsheet. Hit Alt+F11 to open the VB Editor.

Click Tools=>References

Are there any words like 'Missing' or 'Error' or 'Not Found' next to any of the items that are ticked?
0
 
Rrave26Author Commented:
I have McAffee 8.8  I just noticed that there was an issue when I tried to upload the file to experts exchange.  I am trying to run the scan now.
0
 
Rrave26Author Commented:
@ James, I have looked and did not find any missing, errors or not found entries next to any of the selected options.
0
 
James ElliottCommented:
Can you copy/paste the code as an alternative to uploading the file?

IE. Open VB Editor (ALT+F11) => Double click all objects on the left, in turn, and copy/paste all code on the right into this thread.
0
 
Rrave26Author Commented:
Modules

Mod 1
Sub WeeklyTTIR(StDate As Date, EndDate As Date)
Dim WS As Worksheet
Dim WSRaw As Worksheet
Const ColOddRow = 12040422
Dim MaxRow As Long, MaxCol As Long, I As Long, J As Long, LCount As Long, FirstRow As Long

'---> Disable Events
With Application
    .EnableEvents = False
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

'---> initialise Variables
Set WS = ActiveSheet
Set WSRaw = Sheets("IM Raw Data")
MaxRow = WSRaw.Range("A" & WSRaw.Rows.Count).End(xlUp).Row
MaxCol = WSRaw.Columns(WSRaw.Columns.Count).End(xlToLeft).Column
J = 4

'---> Clean Present Report
WS.Range("4:" & WS.Rows.Count).EntireRow.Delete

'---> Filter Data in IM raw Data for the selected period
If WSRaw.FilterMode = True Then WSRaw.ShowAllData
WSRaw.UsedRange.AutoFilter Field:=WSRaw.Columns("I").Column, Criteria1:="=HBCA", _
        Operator:=xlOr, Criteria2:="=HBUS"
WSRaw.UsedRange.AutoFilter Field:=WSRaw.Columns("K").Column, Criteria1:=">=" & StDate, Operator:=xlAnd, Criteria2:="<=" & EndDate

'---> Start Process
For I = 2 To MaxRow
    If WSRaw.Range("A" & I).EntireRow.Hidden = False Then
        If FirstRow = 0 Then FirstRow = J
        '---> Affect Data to Cells
        WS.Range("A" & J) = J - 3
        WS.Range("B" & J) = WSRaw.Cells(I, "K")
        WS.Range("C" & J) = WSRaw.Cells(I, "B")
        WS.Range("D" & J) = WSRaw.Cells(I, "C")
        If WSRaw.Cells(I, "AR") <> "" Then WS.Range("E" & J) = TimeValue(WSRaw.Cells(I, "AR"))
        If WSRaw.Cells(I, "AU") <> "" Then WS.Range("F" & J) = TimeValue(WSRaw.Cells(I, "AU"))
        WS.Range("G" & J).Formula = "=F" & J & "-E" & J
        WS.Range("H" & J) = WSRaw.Cells(I, "G")
   
        '---> Format the Row
        If J Mod 2 <> 0 Then WS.Range("A" & J & ":H" & J).Interior.Color = ColOddRow
        WS.Range("A" & J & ":H" & J).HorizontalAlignment = xlCenter
        WS.Range("A" & J & ":H" & J).Cells.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
        WS.Range("A" & J & ":H" & J).Cells.Borders.LineStyle = xlContinuous
        WS.Range("B" & J).NumberFormat = "dd-mmm-yyyy"
        WS.Range("E" & J & ":F" & J).NumberFormat = "hh:mm"
        WS.Range("G" & J).NumberFormat = "hh:mm:ss"
       
        '---> Increment Counters
        J = J + 1
        LCount = LCount + 1
       
    End If

Next I

If FirstRow <> 0 Then
   
    '---> Make final Formating and Display Totals
    WS.Range("A" & FirstRow & ":H" & J - 1).Cells.BorderAround LineStyle:=xlContinuous, Weight:=xlThick
    WS.Range("F" & J + 1) = "Average TTIR"
    WS.Range("F" & J + 2) = "Percent sent on time"
   
    '---> formulas
    '=TEXT(AVERAGE(G4:G14),"h:mm:ss")
    WS.Range("G" & J + 1).Formula = "=AVERAGE(G" & FirstRow & ":G" & J - 1 & ")"
    WS.Range("G" & J + 1).NumberFormat = "hh:mm:ss"
   
    '=TEXT(COUNTIF(G4:G14,"<=0:15:00")/COUNT(G4:G14),"0.0%")
    WS.Range("G" & J + 2).Formula = "=COUNTIF(G" & FirstRow & ":G" & J - 1 & "," & Chr(34) & "<=0:15:00" & Chr(34) & ")/COUNT(G" & FirstRow & ":G" & J - 1 & ")"
    WS.Range("G" & J + 2).NumberFormat = "0.0%"
   
    '---> Format Totals
    WS.Range("F" & J + 1 & ":G" & J + 2).Font.Bold = True
    WS.Range("F" & J + 1 & ":F" & J + 2).HorizontalAlignment = xlLeft
    WS.Range("G" & J + 1 & ":G" & J + 2).HorizontalAlignment = xlCenter
   
    '---> Change Title
    WS.Shapes("TextBox4").OLEFormat.Object.Text = "TTIR Weekly Report Ending " & Format(EndDate, "dd-mmm-yyyy") & " for Incident Management "
End If

'---> Disable Events
With Application
    .EnableEvents = True
    .ScreenUpdating = True
    .DisplayAlerts = True
End With

'---> Advise User
If FirstRow <> 0 Then
    MsgBox ("Weekly Report for period ending " & EndDate & " gerated " & LCount & " records successfully.")
Else
    MsgBox ("No Data was found in this interval.")
End If

'---> Unfilter Data
If WSRaw.FilterMode = True Then WSRaw.ShowAllData


End Sub
0
 
Rrave26Author Commented:
mod 2
Sub DQRReport(StDate As Date, EndDate As Date)
Dim WS As Worksheet
Dim WSRaw As Worksheet
Const ColOddRow = 12040422
Dim MaxRow As Long, MaxCol As Long, I As Long, J As Long, LCount As Long, FirstRow As Long

'---> Disable Events
With Application
    .EnableEvents = False
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

'---> initialise Variables
Set WS = ActiveSheet
Set WSRaw = Sheets("IM Raw Data")
MaxRow = WSRaw.Range("A" & WSRaw.Rows.Count).End(xlUp).Row
MaxCol = WSRaw.Columns(WSRaw.Columns.Count).End(xlToLeft).Column
J = 4

'---> Clean Present Report
WS.Range("4:" & WS.Rows.Count).EntireRow.Delete

'---> Filter Data in IM raw Data for the selected period
If WSRaw.FilterMode = True Then WSRaw.ShowAllData
WSRaw.UsedRange.AutoFilter Field:=WSRaw.Columns("J").Column, Criteria1:=">=" & StDate, Operator:=xlAnd, Criteria2:="<=" & EndDate

'---> Start Process
For I = 2 To MaxRow
    If WSRaw.Range("A" & I).EntireRow.Hidden = False Then
        If FirstRow = 0 Then FirstRow = J
        '---> Affect Data to Cells
        WS.Range("A" & J) = J - 3
        WS.Range("B" & J) = WSRaw.Cells(I, "J")
        WS.Range("C" & J) = WSRaw.Cells(I, "B")
        WS.Range("D" & J) = WSRaw.Cells(I, "C")
        WS.Range("E" & J) = WSRaw.Cells(I, "D")
        WS.Range("F" & J) = WSRaw.Cells(I, "AE")
       
        '---> Format the Row
        If J Mod 2 <> 0 Then WS.Range("A" & J & ":F" & J).Interior.Color = ColOddRow
        WS.Range("A" & J & ":F" & J).HorizontalAlignment = xlCenter
        WS.Range("A" & J & ":F" & J).Cells.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
        WS.Range("A" & J & ":F" & J).Cells.Borders.LineStyle = xlContinuous
        WS.Range("B" & J).NumberFormat = "dd-mmm-yyyy"
        WS.Range("E" & J & ":F" & J).NumberFormat = "hh:mm"
        WS.Range("F" & J).WrapText = True
       
        '---> Increment Counters
        J = J + 1
        LCount = LCount + 1
       
    End If

Next I

If FirstRow <> 0 Then
   
    '---> Make final Formating and Display Totals
    WS.Range("A" & FirstRow & ":F" & J - 1).Cells.BorderAround LineStyle:=xlContinuous, Weight:=xlThick
     
       
    '---> Change Title
    WS.Shapes("TextBox4").OLEFormat.Object.Text = "DQR Follow Up Report Ending " & Format(EndDate, "dd-mmm-yyyy") & " for Incident Management "
End If

'---> Disable Events
With Application
    .EnableEvents = True
    .ScreenUpdating = True
    .DisplayAlerts = True
End With

'---> Advise User
If FirstRow <> 0 Then
    MsgBox ("Weekly Report for period ending " & EndDate & " gerated " & LCount & " records successfully.")
Else
    MsgBox ("No Data was found in this interval.")
End If

'---> Unfilter Data
If WSRaw.FilterMode = True Then WSRaw.ShowAllData


End Sub
0
 
Rrave26Author Commented:
Sheet 10 weekly TTIR
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
     'check cells for desired format to trigger the calendarfrm.show routine
     'otherwise exit the sub
    Dim DateFormats, DF
    DateFormats = Array("m/d/yy;@", "mmmm d yyyy")
    For Each DF In DateFormats
        If DF = Target.NumberFormat Then
            If CalendarFrm.HelpLabel.Caption <> "" Then
                CalendarFrm.Top = 100
                CalendarFrm.Left = 1000
                CalendarFrm.Height = 190 + CalendarFrm.HelpLabel.Height
            Else: CalendarFrm.Height = 190
                CalendarFrm.Show
            End If
        End If
    Next
End Sub

Private Sub CommandButton1_Click()
If Range("J2") <> "" And Range("K2") <> "" Then
    If Range("J2") > Range("K2") Or Range("K2") < Range("J2") And Range("J2") <> "" And Range("K2") <> "" Then
        MsgBox ("Wrong Dates Sequence Selected From should be Smaller than To and Vice Versa. Check Dates and Try again")
    Else
        If MsgBox("Generate Weekly Report From: " & Range("J2") & " to " & Range("K2") & " ? ", vbQuestion + vbYesNo, "Weekly Report") = vbYes Then
            WeeklyTTIR Range("J2"), Range("K2")
        End If
    End If
End If
End Sub
0
 
Rrave26Author Commented:
This Workbook
Private Sub Workbook_Open()

Sheets("Home").Activate

End Sub
0
 
Rrave26Author Commented:
Worksheet Home


Private Sub CommandButton1_Click()
UserForm1.Show
End Sub

Private Sub TextBox1_Change()
End Sub

Private Sub CommandButton2_Click()
Sheets("Team Metrics").Select
End Sub

Private Sub CommandButton3_Click()
Sheets("Dashboard").Select
End Sub

Private Sub CommandButton4_Click()
Sheets("Weekly TTIR").Select
End Sub

Private Sub Label1_Click()

End Sub

Private Sub CommandButton5_Click()
Sheets("HBUS Dashboard").Select
End Sub

Private Sub CommandButton6_Click()
Sheets("HBCA Dashboard").Select
End Sub
0
 
Rrave26Author Commented:
Worksheet Dashboard

Private Sub Worksheet_Activate()
    ActiveWindow.ScrollRow = 1
End Sub

Private Sub CommandButton1_Click()
Sheets("Home").Select
End Sub
0
 
Rrave26Author Commented:
I am going to unitall 2013 and reinstall 2010 to see if there is an issue.
0
 
Martin LissRetired ProgrammerCommented:
I have McAffee 8.8  I just noticed that there was an issue when I tried to upload the file to experts exchange.  I am trying to run the scan now.
What was the result of the scan?
0
 
Rrave26Author Commented:
The scan showed no virus.
0
 
Rrave26Author Commented:
I am guessing that my file has become corrupt.
0
 
Martin LissRetired ProgrammerCommented:
Save it as an xlsb file and see if you can then reopen it.
0
 
Rrave26Author Commented:
That didn't work either.
0
 
Rrave26Author Commented:
All of the information and suggestions were excellent in troubleshooting this issue, however in the end the database still doesn't work and I will rebuild the database.
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 17
  • 5
  • 4
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now