Single Click a cell to add 1

hrayani

Well-known Member
Joined
Jul 23, 2010
Messages
1,522
Office Version
  1. 2016
Platform
  1. Windows
Hi Guys,

What i want is when i click cell A1 then 1 should be added in the existing value of cell B1...

regards,

Humayun
 

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
Try this:

Code:
[/FONT]
[FONT=Courier New]Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 If Selection.Count > 1 Then Exit Sub
 If Not Intersect(Target, Range("A1")) Is Nothing Then
  Range("B1").Value = Range("B1").Value + 1
 End If
End Sub
 
Upvote 0
Hi Pedie,

no dear its not working.. nothing is happening when i click cell A1
 
Upvote 0
Suppose you are to click on A1 of sheet1 then open VBA editor [alt + F11] double click on Sheet1 module then paste this code and try it again. If you have already done this then check if events are on...:)Works for me!
 
Upvote 0
Thanks Pedie,

i am so stupid. i am working on sheet3 and i pasted the code in sheet1..

Working great...

now pls tell me that what to do if i want to expand the range..

Rnage = A1:A10 > any cell clicked on column A in the mentioned range to add 1 in column B in range B1:B10

following are the ranges which i require

A1:A10 should Add 1 in B1:B10
C1:C10 should Add 1 in D1:D10
E1:E10 should Add 1 in F1:F10
G1:G10 should Add 1 in H1:H10
I1:I10 should Add 1 in J1:J10
K1:K10 should Add 1 in L1:L10
M1:M10 should Add 1 in N1:N10
O1:O10 should Add 1 in P1:P10
Q1:Q10 should Add 1 in R1:R10
S1:S10 should Add 1 in T1:T10

Awaiting Reply,

Humayun
 
Upvote 0
Lets day you click on A2, then you wanna add 1 to B2 correct?, or add 1 to all the cell in B1:B10.....

or just correspoding column..


See if this is what u want:
Rich (BB code):
Rich (BB code):
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 If Selection.Count > 1 Then Exit Sub
 If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
  Target.Offset(0, 1).Value = Target.Offset(0, 1).Value + 1
 End If
End Sub
.


 
Upvote 0
Because pedie's solution is in a selection_change event, it needs what's selected on the sheet to change, so repeated clicking of A1, will not change the selection so will not repeatedly add 1 to B1, only the first time. You could try a small change (but this will make it awfully difficult to edit A1!):
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("A1")) Is Nothing Then
  With Range("B1")
    .Value = .Value + 1
    .Select
  End With
End If
End Sub
Otherwise, if you'd be content with a double-click instead:
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Selection.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("A1")) Is Nothing Then
  With Range("B1")
    .Value = .Value + 1
  End With
  Cancel = True
End If
End Sub
 
Upvote 0
Thanks Pedie,

Yes exactly this is what i want any cell clicked on column A should add 1 in column be exactly on the right cell...

pls if you can input all the ranges mentioned in the code...

Regards,

Humayun
 
Upvote 0
Dear P45Cal

Thanks for you reply.... yes you made the right point... that every time i have to change the selection and go to it again to add 1 in the desired cell..

pls give me few minutes... i will try your code too and let you know shortly..

Once again thanks...

Regards,

Humayun
 
Upvote 0
my suggestions adjusted for the new range (use either one or the other, not both):
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count > 1 Then Exit Sub
Set zzz = Range("$A$1:$A$10,$C$1:$C$10,$E$1:$E$10,$G$1:$G$10,$I$1:$I$10,$K$1:$K$10,$M$1:$M$10,$O$1:$O$10,$Q$1:$Q$10,$S$1:$S$10")
If Not Intersect(Target, zzz) Is Nothing Then
  With Target.Offset(, 1)
    .Value = .Value + 1
    .Select  'optional
  End With
End If
End Sub
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Set zzz = Range("$A$1:$A$10,$C$1:$C$10,$E$1:$E$10,$G$1:$G$10,$I$1:$I$10,$K$1:$K$10,$M$1:$M$10,$O$1:$O$10,$Q$1:$Q$10,$S$1:$S$10")
If Not Intersect(Target, zzz) Is Nothing Then
  With Target.Offset(, 1)
    .Value = .Value + 1
  End With
  Cancel = True
End If
End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,224,590
Messages
6,179,761
Members
452,940
Latest member
rootytrip

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top