Microsoft Excel - Runtime error 6 Overflow - Asked By oz on 25-Jan-11 10:02 AM

I have recently developed a file with several procedures in Excel 2007 version. It is intended to be used in several countries in our organization. When the file is opening the MENU page appears. When the first menu button is clicked a User Form is supposed to appear. In this user form there are several listboxes and textboxes. I have added also a calendar consists of three listboxes for day, month and year seperately (I have done this with a code rather than using the built-in calendar functions to avoid registration/reference errors in different computers).

In some countries this User Form works perfectly all right while in some countries an error occurs before the User Form opens. It says: "Runtime error  6.  Overflow"

Where should I look for the origin of this error? Could it be related to Regional settings (especially date formats) in each country?

Any help appreciated. The file can be sent on request.

//Oz

Hi

This could be handled within the code. Why dont you post your code

Here is the code:
The "runtime Error 6" occurs when Sub Button1_Click() is triggered.
How can I send the whole file (Test_v1.xlms) to you to see how it runs and User Forms?

Dim rw As Range
Dim rsm As String, rsm_first As String, s_chain As String
Dim v_date As Date, today As Date
Dim company As String, pers_ssab As String, pers_comp As String
Dim v_notes As String, follow_up As String, evaluate As String
Dim row_base As Integer, col_base As Integer
Dim icount As Integer, wm As Integer
Public sep As String
Public submit_flag As Integer
Dim alan(1 To 6) As String

Option Explicit

Sub Auto_open()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Refresh_VNotes
    Refresh_Customers
    Sheets("MENU").Select
    Range(Cells(1, 1), Cells(1, 20)).Select
    ActiveWindow.Zoom = True
End Sub

Sub Button1_Click()

On Error GoTo errhand1
   
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
   
    Refresh_Customers
   
    today = VBA.Date
    sep = VBA.Mid(today, 3, 1)
   
    With UF1
      .ListBox1.Clear
      .ListBox2.Clear
      .ListBox3.Clear
      .TextBox1 = ""
      .TextBox2 = ""
      .TextBox3 = ""
      .TextBox4 = ""
      .ComboBox1.Clear
      .ComboBox2.Clear
      .ComboBox3.Clear
    End With
      
'---fill in Date
    With UF1
      Dim ay(12) As String
      For icount = 1 To 12
        ay(icount) = VBA.Format(("1" & sep & icount & sep & "01"), "MMMM")
        .ComboBox2.AddItem ay(icount)
      Next icount
      .ComboBox2.Value = VBA.Format(today, "MMMM")
      wm = .ComboBox2.ListIndex
     
      Dim yil As Integer
      For yil = 2000 To 2029
        .ComboBox3.AddItem yil
      Next yil
      .ComboBox3.Value = VBA.Format(today, "YYYY")
     
      Dim max_gun As String
      Dim gun(31) As String
     
      If wm = 3 Or wm = 5 Or wm = 8 Or wm = 10 Then
        max_gun = 30
      ElseIf wm = 1 Then
        max_gun = 28
        For icount = 0 To 29 Step 4
        If .ComboBox3.Value = 2000 + icount Then
          max_gun = 29
        End If
        Next
      Else
        max_gun = 31
      End If
     
      For icount = 1 To max_gun
        gun(icount) = VBA.Format((icount & sep & "01" & sep & "01"), "DD")
        .ComboBox1.AddItem gun(icount)
      Next icount
     
      .ComboBox1.Value = VBA.Format(today, "DD")
    End With
   
'---fill in RSMs
    Sheets("SETTINGS").Activate
    Range("RSMs").Select
    'Selection.Columns(1).Select
    rsm = Selection.Cells(1, 1)
    rsm_first = rsm
    'UF1.ListBox1.AddItem rsm
   
    For Each rw In Selection
      UF1.ListBox1.AddItem rw.Value
      'rsm = rw.Value
    Next rw
   
    UF1.ListBox1.ListIndex = 0
    UF1.ListBox1.SetFocus
         
'---fill in Customers for that specific RSM---
  If Sheets("CUSTOMERS").Cells(2, 2) <> "" Then
    Range("Cust_Base").Select
    Selection.Columns(5).Select
   
    For Each rw In Selection
      If rw.Value = rsm_first Then
        UF1.ListBox2.AddItem rw.Offset(0, -3).Value
      Else
        UF1.ListBox2.AddItem ""
      End If
    Next rw
   
    UF1.ListBox2.ListIndex = 0
    UF1.ListBox2.SetFocus
   
 '********* This section added to solve a bug ******
 '********* that caused duplicating Customer list in "ListBox2" *****
    UF1.ListBox2.Clear
    Sheets("CUSTOMERS").Activate
    Range("Cust_Base").Select
    Selection.Columns(5).Select
   
    For Each rw In Selection
      If rw.Value = UF1.ListBox1 Then UF1.ListBox2.AddItem rw.Offset(0, -3).Value
    Next rw
   
    For Each rw In Selection
      If rw.Value = UF1.ListBox1.Text Then
        UF1.ListBox2.Text = rw.Offset(0, -3).Value
        Exit For
      End If
    Next rw
  End If
'***********

    'UF1.ListBox3.Clear
    UF1.ListBox3.List = Array("Ordinary", "Important", "Very important")
    UF1.ListBox3.ListIndex = 0
    UF1.ListBox3.SetFocus
   
    UF1.TextBox1.SetFocus
    UF1.TextBox1.Text = UF1.ListBox1.Value
   
   
    Do          '---waits for the NEXT record unless END is pressed--
      submit_flag = 0
      Small
      UF1.Show
    
      GetInput      '---gets all input from UF1 and writes them into list on sheet "VISIT NOTES"
  
      With UF1
        '.TextBox1 = ""
        '.TextBox2 = ""
        .TextBox3 = ""
        .TextBox4 = ""
        .TextBox1.SetFocus
      End With
    Loop
   
errhand1: UF1.Hide
Sheets("MENU").Select

End Sub

Hi

The error occurs due to the way you handle the dates..

Here are some tips that will definitely help you improve the way your coding. Please get back incase I havent covered any part which you would need in your code.

Dear Jackpot,

Sorry for the late response. First of all I have restructered the procedures around the ideas you have given but it took me 3-4 days to deal with it. Then I have sent the files to several countries for testing. The result is positive. We have overcome this error with the new code as follows:

'---fill in Date  (MAIN MODULE)
       
    With UF1
     
      For icount = 2000 To 2029
        .ComboBox3.AddItem icount
      Next icount
     
      For icount = 1 To 12
        .ComboBox2.AddItem Format(DateSerial(Year(Date), icount, 1), "MMMM")
      Next icount
     
      .ComboBox2.Value = Format(Date, "MMMM")
      .ComboBox3.Value = Format(Date, "YYYY")
           
    End With
'------------------------- CLASS MODULES for ComboBox2 & 3

Dim Year_Selected As Integer
Dim Month_Selected As Integer
Dim intDays As Integer

Option Explicit

--------------------------------------

Private Sub ComboBox2_Change()
    With UF1
      .ComboBox1.Clear
      Month_Selected = .ComboBox2.ListIndex + 1
     
      intDays = Day(DateSerial(Year_Selected, Month_Selected + 1, 0))
    
      For icount = 1 To intDays
        .ComboBox1.AddItem icount
      Next icount
         
      If Month_Selected = Month(Date) And Year_Selected = Year(Date) Or Year_Selected = 0 Then
        .ComboBox1.Value = Format(Date, "DD")
      Else
        .ComboBox1.ListIndex = 0
      End If
   
    End With
End Sub
-----------------------------------------

Private Sub ComboBox3_Change()
    With UF1
      .ComboBox1.Clear
      Month_Selected = .ComboBox2.ListIndex + 1
      Year_Selected = .ComboBox3.Value
    
      intDays = Day(DateSerial(Year_Selected, Month_Selected + 1, 0))
    
      For icount = 1 To intDays
        .ComboBox1.AddItem icount
      Next icount
     
      If Month_Selected = Month(Date) And Year_Selected = Year(Date) Then
        .ComboBox1.Value = Format(Date, "DD")
      Else
        .ComboBox1.ListIndex = 0
      End If
     
    End With
End Sub

----------------------------------------

Thank you very much.
//Oz