Click to show value in active cell

[Mik]

I require assistance with showing a value within the active cell.
It is intended for a internal company survey, where ratings are given
against adjacent questions.

For example, there are 5 questions, 5 possible ratings.
Columns B,C,D,E,F represent a number from 1 to 5, where B=5, C=4, D=3,
E=2 and F=1.
If Question1(Q1) deserves a 4 rating, then click on cell C1. So, cell
C1 would then show 4 in that cell.

A B C D E F
Q1. 4
Q2. 3
Q3. 5
Q4. 2
Q5. 4

The user will work down the rows from top to bottom, clicking on a
particular column to apply the appropriate rating.

Also, i want only ONE cell per row to be selected, so if user first
chose rating 3, but then wishes to change it to rating 2, i want the
rating 3 to disappear, and show only the new selected rating 2.

Can anybody help with this issue?

Thanks in advance.

 

[Bernie Deitrick]

Mik,

Copy the code below, right-click the sheet tab, select "View Code" and paste the code into the
window that appears.

HTH,
Bernie
MS Excel MVP

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Range("B:F")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Intersect(Target.EntireRow, Range("B:F")).ClearContents
Target.Value = 7 - Target.Column
Application.EnableEvents = True
End Sub

 

[Mik]

Mik,

Copy the code below, right-click the sheet tab, select "View Code" and paste the code into the
window that appears.

HTH,
Bernie
MS Excel MVP

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Range("B:F")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Intersect(Target.EntireRow, Range("B:F")).ClearContents
Target.Value = 7 - Target.Column
Application.EnableEvents = True
End Sub












- Show quoted text -

Bernie,
Fantastic... Thanks a lot.
Mik

 

[Mik]

Bernie,
Fantastic... Thanks a lot.
Mik- Hide quoted text -

- Show quoted text -

Bernie,

If i wanted to extend the survey, and add seperate questions where
answers would be in columns H:L (in addition to columns B:F), how
would i calculate this?

Mik

 

[Bernie Deitrick]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Range("B:F, H:L")) Is Nothing Then Exit Sub
Application.EnableEvents = False
If Intersect(Target, Range("B:F")) Is Nothing Then
Intersect(Target.EntireRow, Range("H:L")).ClearContents
Target.Value = 13 - Target.Column
Else
Intersect(Target.EntireRow, Range("B:F")).ClearContents
Target.Value = 7 - Target.Column
End If
Application.EnableEvents = True
End Sub


HTH,
Bernie
MS Excel MVP

Bernie,
Fantastic... Thanks a lot.
Mik- Hide quoted text -

- Show quoted text -

Bernie,

If i wanted to extend the survey, and add seperate questions where
answers would be in columns H:L (in addition to columns B:F), how
would i calculate this?

Mik

 

[Mik]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Range("B:F, H:L")) Is Nothing Then Exit Sub
Application.EnableEvents = False
If Intersect(Target, Range("B:F")) Is Nothing Then
   Intersect(Target.EntireRow, Range("H:L")).ClearContents
   Target.Value = 13 - Target.Column
Else
   Intersect(Target.EntireRow, Range("B:F")).ClearContents
   Target.Value = 7 - Target.Column
End If
Application.EnableEvents = True
End Sub

HTH,
Bernie
MS Excel MVP






Bernie,

If i wanted to extend the survey, and add seperate questions where
answers would be in columns H:L (in addition to columns B:F), how
would i calculate this?

Mik- Hide quoted text -

- Show quoted text -

Bernie,

Once again, Thanks.
That's perfect.

Mik