How to get mutally exlusive cells on mouse click

[men]

I am working on a survey

I have a total of 22 questions in 5 groups. Each question can have
only 1 of 5 possible answers. The answers have a value attached such
as:

0-Not At All
1-Somewhat
2-Moderately
3-A Lot
4-Extremely

I have the questions listed down column A. The possible answers are
listed next to each question. For example:

Question in A2: Are you feeling sad?

Answer Text:
0-Not At All in B1
1-Somewhat in C1
2-Moderately in D1
3-A Lot in E1
4-Extremely in F1

When, for example, I click the empty cell C2 I have code which will
put the value "1" visibly into the cell. So I can therefore go click
on the right answers on the whole range of questions and everytime I
click on the "Answer" I get the proper value displayed.

This works great but I would like to take it one step further:

How can I make the "Answer" cells mutally exclusive? Right now it is
possible to click every cell and the corresponding value appears. But
per question only one answer out of the 5 choices is allowed.

How can I do this?

 

[Barb Reinhardt]

This should get you what you need.

dim myRange as range
Dim r as range

If Not Intersect(Target, Range("B:F")) Is Nothing Then
Set myRange = Cells(Target.Row, "B").Resize(1, 5)
'Do whatever you'd do to enter the values in column B-F
For Each r In myRange
If r <> Target Then r.ClearContents
Next r
End If

 

[Barb Reinhardt]

Correction


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Count <> 1 Then Exit Sub

If Not Intersect(Target, Range("B:F")) Is Nothing Then
Set myRange = Cells(Target.Row, "B").Resize(1, 5)
'Do whatever you'd do to enter the values in column B-F
Target.Value = 1
For Each r In myRange
If r.Address <> Target.Address Then r.ClearContents
Next r
End If
End Sub

 

[JMB]

Perhaps:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)

Application.EnableEvents = False

If Not Intersect(Target, Columns("B:F")) Is Nothing Then
With Target
Me.Range("B" & .Row & ":F" & .Row).ClearContents
Select Case .Column
Case Is = 2: .Value = 0
Case Is = 3: .Value = 1
Case Is = 4: .Value = 2
Case Is = 5: .Value = 3
Case Is = 6: .Value = 4
End Select
End With
Cancel = True
End If

Application.EnableEvents = True
End Sub

You could, of course, shorten it up by replacing the select case statement
with
..Value = .Column - 2

 

[Jay]

Hi men@work -

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set surveyRange = Range("A1:F23")
If Not Intersect(Target, surveyRange) Is Nothing Then
If Target = "" Then
tRow = Target.Row
Range(Cells(tRow, 2), Cells(tRow, 6)).ClearContents
'Call your code that enters the answer value here....
End If
End If
End Sub

 

[Dave Peterson]

How about an alternative?

Set up a bunch of optionbuttons (22 groups of 5 in each group). Then you could
use a linked cell to show which option was chosen for each question.

If you want to try, visit Debra Dalgleish's site:
http://contextures.com/xlForm01.html

=======
If you don't want to try that, how about just using a single cell per
question--Use data|Validation to provide the options.

If you really want to use multiple cells per question, you could add a 6th cell
that validates the entry:

=if(counta(b1:f1)=1,"",
if(counta(b1:f1)=0,"Please answer the question","Only one response!"))

 

[men]

Wow - thanks for all of your responses!!!

If it is like that in here then I would like to ask you to check out
my (I am sure) clumsy code that lets me click on the particular cell
to put a number in it. There must be a slicker and more portable way
(relative refernces or some code that changes/adappts when I need to
insert rows/columns or other changes)) than I have.

Would you mind looking at a sample - please let it fly, I am wide open
to constructive criticism, insults, praises etc. I am obviously still
pretty new at VBA.

Here's the sample:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = Range("B8").Address Then _
Range("B8").Value = 0


If Target.Address = Range("B9").Address Then _
Range("B9").Value = 0


If Target.Address = Range("B10").Address Then _
Range("B10").Value = 0

etc.etc.etc

goes on for pages (sigh)


End Sub

 

[Jay]

Hi men@work -

It looks like you want to enter the value "0" (zero) anytime you click in a
cell in column B. Here is one way to do that. Adjust the "rng" variable and
value as necessary.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set rng = Columns("B")
'Set rng = Range("B2:B35") 'Example of specifying a limited range
If Not Intersect(Target, rng) Is Nothing Then
Cells(Target.Row, rng.Column).Value = 0
End If
End Sub

 

[men]

Hi men@work -

It looks like you want to enter the value "0" (zero) anytime you click in a
cell in column B. Here is one way to do that. Adjust the "rng" variable and
value as necessary.

Yes, I want zero in B but I also need "1" in C and "2" in D etc. But I
can only have one of those numbers per row i.e.either a "0" or a "1"
or a "2" but only one of those to the exclusion of the others.

I'll play with it but would not at all mind if someone could tie the
code all togetherfor me (Enter number on click and have it be
mutually exclusive)

I am so happy I am getting help, I am a bit frustrated hacking around
on this by myself for all too long.

Thanks, everybody!!!!

 

[men]

Thanks for this one. It is close to what I am trying to do. I am
running out of time tonight but will play with it tomorrow evening,
after work. At first glance this would do for one survey. Would you
see a way that I could expand on this to track, say, 4 surveys given
to the same person over a period of a year or so?

FYI and FWIW

There will be a few hundred clients taking the same survey several
times over a period of time. They will have a paperform to fill out
which is quite similar to your survey2 form.

I then get to input these into the computer with the purpose of
tracking how their answers are trending over time.

 

[Jay]

Hi m@w -

Here are two versions to mull over. The first version enters numbers to
your specification while the second 'ticks' each selected cell with a
checkmark.

Version 1:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set surveyRange = Range("B2:F23")
If Not Intersect(Target, surveyRange) Is Nothing Then
If Target.Cells.Count > 1 Then
MsgBox "Be careful to click only one cell…. Try again.",
vbInformation, ""
Exit Sub
End If
If Target = "" Then
tRow = Target.Row
Range(Cells(tRow, 2), Cells(tRow, 6)).ClearContents
Target.Value = Target.Column - 1
End If
End If
End Sub

Version 2: Adapted from a technique posted at www.ozgrid.com.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set surveyRng = Range("B2:F23")
If Not Intersect(Target, surveyRng) Is Nothing Then
If Target.Cells.Count > 1 Then
MsgBox "Be careful to click only one cell…. Try again.",
vbInformation, ""
Exit Sub
End If

With Target
.Font.Name = "Marlett"
.HorizontalAlignment = xlCenter
End With
If Target = vbNullString Then
tRow = Target.Row
Range(Cells(tRow, 2), Cells(tRow, 6)).ClearContents
Target = "a"
Else
Target = vbNullString
End If
End If
End Sub

Note that Version 2 uses the letter "a" formatted to marlett font in each
cell to show a checkmark. Preset row heights to at least 14.25 (maybe more
or less on your system) to accomodate the checkmark. Also, to tally the
checkmarks in each column, add the following formula in cell B24 and copy to
C24 - F24: =COUNTIF(B2:B23,"a")

 

[Dave Peterson]

I'd keep each survey in separate workbooks (one workbook per person). Then when
they're returned, put each survey group into its own folder (Folder-1 would hold
the results of survey one for each person).

Then I'd use some macro that would extract the values from the linked cells --
along with the name and survey number.

Survey# Name/id/pertinent_info Question# Result

And combine all the results into one giant worksheet.

Then I could filter, subtotals, pivottables, charts to try to get the
information that I wanted.

Ron de Bruin shares tons of sample code for copying data:
http://www.rondebruin.nl/tips.htm

 

[men]

I only have time to work on this late evenings but, before I'll have
to leave for work this morning, I wanted to give all of yoy a BIG
THANKS for the great, fast and educational help you have given.

I am looking forward to trying all your suggestions starting this
evening and will report back as sson as I have a progress report

Thanks a million, EVERYBODY!!!