Tabulate Survey Responses

**Olasin** · 02-24-2007, 09:51 AM

I've distributed 500 surveys to a community regarding parks and recreation.
Soon we'll be getting them back and I'll need to tabulate over 150 questions manually.

This may seem simple but it's past my Excel skill or knowledge - help would most greatly be appreciated. (btw I really appreciate this forum)

As I read the physical survey I want to click on Excel the response (like a button) and it keeps a running tabulation of each element.

SENIOR TRAVEL IDEAS
Apple Orchards Yes 6 No 2 Unsure 1
Flower Show Yes 3 No 5 Unsure 0
Movies Yes 4 No 4 Unsure 0
Ocean/Beach Yes 1 No 2 Unsure 6
Strawberry Banke Yes 5 No 3 Unsure 0
Summer Theatre Yes 2 No 4 Unsure 0
Water Park Yes 0 No 0 Unsure 9

Thanks for help....

**davesexcel** · 02-24-2007, 11:43 AM

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
'right click a couple of times on any cell in column A
    If Union(Range("$A:$A"), Target).Address = Range("$A:$A").Address Then
        ActiveCell.Offset.Value = ActiveCell.Value + 1
        Cancel = True
    End If
End Sub

this code goes into the worksheet module

right click on the sheet tab and select view codes paste the above code there

**Olasin** · 02-24-2007, 10:33 PM

Haven't done a subroutine

or worksheet module
but I'll see where I go
Thanks for your response
I'll be back to confirm or ask for more....:

**Olasin** · 02-24-2007, 11:43 PM

Your routine worked for column A but when I tried to have it work for columns b-e I messed up.

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
'right click a couple of times on any cell in column A
If Union(Range("$A:$A"), Target).Address = Range("$A:$A").Address Then
ActiveCell.Offset.Value = ActiveCell.Value + 1
Cancel = True
End If
End Sub
Private Sub Worksheet_BeforeRightClick_B(ByVal Target As Range, Cancel As Boolean)
'right click any cell in column B
If Union(Range("$B:$B"), Target).Address = Range("$B:$B").Address Then
ActiveCell.Offset.Value = ActiveCell.Value + 1
Cancel = True
End If
End Sub
Private Sub Worksheet_BeforeRightClick_C(ByVal Target As Range, Cancel As Boolean)
'right click any cell in column C
If Union(Range("$C:$C"), Target).Address = Range("$C:$C").Address Then
ActiveCell.Offset.Value = ActiveCell.Value + 1
Cancel = True
End If
End Sub

Private Sub Worksheet_BeforeRightClick_D(ByVal Target As Range, Cancel As Boolean)
'right click any cell in column D
If Union(Range("$D:$D"), Target).Address = Range("$D:$D").Address Then
ActiveCell.Offset.Value = ActiveCell.Value + 1
Cancel = True
End If
End Sub

Private Sub Worksheet_BeforeRightClick_E(ByVal Target As Range, Cancel As Boolean)
'right click any cell in column E
If Union(Range("$E:$E"), Target).Address = Range("$E:$E").Address Then
ActiveCell.Offset.Value = ActiveCell.Value + 1
Cancel = True
End If
End Sub

**davesexcel** · 02-25-2007, 03:19 AM

this should work better

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
'right click a couple of times on any cell in column A
    If Union(Range("$A:$A"), Target).Address = Range("$A:$A").Address Then
        ActiveCell.Offset.Value = ActiveCell.Value + 1
        Cancel = True
    End If
    'right click any cell in column B
    If Union(Range("$B:$B"), Target).Address = Range("$B:$B").Address Then
        ActiveCell.Offset.Value = ActiveCell.Value + 1
        Cancel = True
    End If
    'right click any cell in column C
    If Union(Range("$C:$C"), Target).Address = Range("$C:$C").Address Then
        ActiveCell.Offset.Value = ActiveCell.Value + 1
        Cancel = True
    End If
    'right click any cell in column D
    If Union(Range("$D:$D"), Target).Address = Range("$D:$D").Address Then
        ActiveCell.Offset.Value = ActiveCell.Value + 1
        Cancel = True
    End If
    'right click any cell in column E
    If Union(Range("$E:$E"), Target).Address = Range("$E:$E").Address Then
        ActiveCell.Offset.Value = ActiveCell.Value + 1
        Cancel = True
    End If
End Sub