Replacing Input Box in Macro with Info Picked Up from Active Cell?

[Wart]

I've inherited a spreadshhet for tracking the demographics of proper names
used in textbooks we produce. There are several macros involved, but the key
one uses an Input Box to prompt the user for a name (followed by a comma and
the lesson number in which it is used). It takes that information to match up
the name in a Master List on another sheet and then indicate on the active
sheet what the name's demographic breakdown is, if it's already been used in
the book, and/or if it's on the Master List at all. Here is the full code:

Sub ClassifyName()
myRow = ActiveCell.Row
CurrentSheet = ActiveSheet.Name
UserInput$ = InputBox$("Name,Lesson")
i = InStr(1, UserInput$, ",")
If i > 0 Then
uName$ = Left$(UserInput$, i - 1)
uLesson$ = Mid$(UserInput$, i + 1)
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("All Names").Select
On Error GoTo NoSuchName
Cells.Find(what:=uName$, After:=ActiveCell, LookIn:=xlFormulas,
Lookat _
:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext,
MatchCase _
:=False).Activate
If Selection.Interior.ColorIndex = 46 Then
MsgBox uName$ + " has been used previously."
Exit Sub
End If
With Selection.Interior
.ColorIndex = 46
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Selection.Offset(0, 1).Select
EthnicGroup = Val(Selection.Offset(0, 0).Text)
Selection.Offset(0, 1).Select
SexIndicator = Val(Selection.Offset(0, 0).Text)
Selection.Offset(0, 1).Select
Sheets(CurrentSheet).Select
ActiveCell.FormulaR1C1 = uLesson$
Worksheets(CurrentSheet).Cells(myRow, 2).Select
ActiveCell.FormulaR1C1 = uName$
Worksheets(CurrentSheet).Cells(myRow, EthnicGroup).Select
ActiveCell.FormulaR1C1 = 1
If SexIndicator > 0 Then
Worksheets(CurrentSheet).Cells(myRow, SexIndicator).Select
ActiveCell.FormulaR1C1 = 1
End If
Worksheets(CurrentSheet).Cells(myRow + 1, 1).Select
Else
MsgBox "Your input was invalid!"
End If
Exit Sub
NoSuchName:
MsgBox "Your name was not found!"
End Sub

All I want to do with this code for now is this: Instead of prompting the
user for a name and lesson number with an Input Box, it should simply pick up
the name from the active cell. I've appended the following Worksheet_Change
code to the sheet in question, so that the ClassifyNames macro runs
automatically when a cell the range mantioned is changed--that is, when a
name (or anything, for that matter) is entered in the targeted range:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B14:B1000")) Is Nothing Then
Application.EnableEvents = False
Application.Run "ClassifyName"
Application.EnableEvents = True
End If
End Sub

Can I now modify the "ClassifyName" macro so that, when initiated, it picks
up the the name from the active cell and then performs the rest of the
routine it's already doing? Currently, the user has to type a name into the
active cell, run the macro, and re-enter the name in the Input Box to have it
looked up in the Master List--a redundancy of entry that I'm trying to avoid.
And I don't need the lesson number info to be entered at all.

There are many other things about this macro that suck, but the initial
entry is the most immediately annoying. I'm hoping I can deal with other
weirdness over time--but can anyone out there help me with this initial
problem?

Thanks in advance!

 

[Dave Peterson]

Maybe...

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Me.Range("B14:B1000")) Is Nothing Then
Application.EnableEvents = False
Call ClassifyName(Target.Value)
Application.EnableEvents = True
End If
End Sub

And a skinnied down version of your macro:

Option Explicit
Sub ClassifyName(Optional UserInput$ = "")
If UserInput$ = "" Then
UserInput$ = InputBox$("Name,Lesson")
End If
MsgBox UserInput
End Sub

 

[JLatham]

To just get the name from the active cell on the active sheet, replace your
UserInput$ = InputBox$("Name,Lesson")
with
UserInputs$ = ActiveCell.Value
The rest of the code should pretty much work. There should not be a comma
in the cell (or else your code will try to use it to divide the contents of
the cell into a name and lesson). This is also going to have the effect of
not providing a lesson at all.

You really probably want to fine tune the range examined in the
Worksheet_Change event - unless all the cells will contain names?

Also, to keep from evaluating things when multiple cells are selected, or
you've chosen a bunch and hit the [Del] key you might add this as the first
executable lines in the Worksheet_Change event handler:

If Target.Cells.Count > 1 Then
'multiple cells/rows/columns selected - quit!
Exit Sub
End If
.... continue on here with your Intersect test

Hope this helps some.

 

[Jim Thomlinson]

I think this does what you want. I got rid of the selects and such to make
it more efficient. I hope I translated it correctly...

Sub ClassifyName(ByVal InputName As String)
Dim rngFound As Range
Dim EthnicGroup As Long
Dim SexIndicator As Long

Set rngFound = Sheets("All Names").Cells.Find(What:=InputName, _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
MatchCase:=False)
If rngFound Is Nothing Then
MsgBox "Your input was invalid!", vbCritical
Else
If rngFound.Interior.ColorIndex = 46 Then
MsgBox InputName & " has been used previously."
Else
With rngFound
.Interior .ColorIndex = 46
EthnicGroup = Val(.Offset(0, 1).Text)
SexIndicator = Val(.Offset(0, 2).Text)
End With
ActiveCell.Value = "Stuff"
Worksheets(CurrentSheet).Cells(ActiveCell.Row, 2).Value =
InputName
Worksheets(CurrentSheet).Cells(ActiveCell.Row,
EthnicGroup).Value = 1
If SexIndicator > 0 Then
Worksheets(CurrentSheet).Cells(myRow, SexIndicator).Value = 1

End If
ActiveCell.Offset(1, 0).Select
End If

Else
MsgBox "Your input was invalid!"
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("B14:B1000")) Is Nothing Then
With Application
.EnableEvents = False
Call ClassifyName(Target.Value)
.EnableEvents = True
End With
End If
End Sub