Hi,
I have a user who has approached me with an Excel coding issue.
Here is the problem and the code. If anyone can run through this and
fix then it would be most appreciated. I simply do not have the
knowledge or skill in this area to assist.
Run-time Error ‘9’: Subscript Out of Range which pops out every time I
open the excel spreadsheet.
Full Code is featured below. It does two things:
1. allows multiple entries in the same cell using the drop down
options of a data validation function.
2. Allows the users to type their name in cell A1 which then
automatically allows the user to locate the column containing their
name.
However, there are a number of problems:
• when you delete the entry from within the cell itself, the end if
statements loops so that even if the new value is deleted it would
just replicate old and new entries hence the entries appears twice,
three times or however many entries you delete.
• There is a Microsoft Visual Basic – Run-time Error ‘9’: Subscript
Out of Range which pops out every time the document is opened
• Another dialogue box pops open when the document is saved -
compatibility checker
• ‘Summary – Minor loss of fidelity
o Some formulas in this workbook are linked to other workbooks that
are closed (NB: This spreadsheet has been taken off from the web but
the sheets are hidden), When these formulas are recalculated in
earlier versions of excel without opening the linked workbooks,
characters beyond the 255 character limit cannot be returned…Location:
Defined names
o An embedded object in this worksheet is created in a newer version
of office. You cannot edit it in an earlier version of excel…location:
Read me.
I’ll save a blank version on the h/general/jw
The code….
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
If Target.Count > 1 Then GoTo exitHandler
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
If Intersect(Target, rngDV) Is Nothing Then
'do nothing
Else
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If Target.Column = 2 Then
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
Target.Value = oldVal _
& ", " & newVal
End If
End If
End If
If Target.Column = 3 Then
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
Target.Value = oldVal _
& ", " & newVal
End If
End If
End If
If Target.Column = 4 Then
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
Target.Value = oldVal _
& ", " & newVal
End If
End If
End If
If Target.Column = 5 Then
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
Target.Value = oldVal _
& ", " & newVal
End If
End If
End If
If Target.Column = 6 Then
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
Target.Value = oldVal _
& ", " & newVal
End If
End If
End If
If Target.Column = 7 Then
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
Target.Value = oldVal _
& ", " & newVal
End If
End If
End If
If Target.Column = 8 Then
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
Target.Value = oldVal _
& ", " & newVal
End If
End If
End If
If Target.Column = 9 Then
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
Target.Value = oldVal _
& ", " & newVal
End If
End If
End If
If Target.Column = 10 Then
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
Target.Value = oldVal _
& ", " & newVal
End If
End If
End If
exitHandler:
Application.EnableEvents = True
Dim Found As Range
If Target.Address(False, False) = "A1" Then
Set Found = Rows(3).Find(what:=Target.Value, LookIn:=xlValues,
lookat:=xlWhole)
If Found Is Nothing Then
MsgBox "Error in name!"
Else
Found.Offset(1).Select
End If
End If
End Sub
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links :
http://twitter.com/exceldailytip
2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
<><><><><><><><><><><><><><><><><><><><><><>
HELP US GROW !!
We reach over 7000 subscribers worldwide and receive many nice notes about the
learning and support from the group.Let friends and co-workers know they can
subscribe to group at http://groups.google.com/group/excel-macros/subscribe
