VBA to have user select a cell in column A have a 1 placed as a result of selection and a 2 placed in the next selected, etc

[juscuz419]

Trying to find an easy way to have a user prompted ONCE to select a cell in Column A, have a 1 placed in that cell, then for each cell the user "clicks" on

Sub SelectAndFill()
    Dim i As Long
    Dim rng As Range 'declare a variable to store the selected cell
    Dim firstCell As Range 'declare a variable to store the first cell
    i = 1 'initialize the counter
    Set firstCell = Application.InputBox("Select the first cell in column A", Type:=8) 'assign the first cell to the variable
    If firstCell.Column = 1 Then 'check if the first cell is in column A
        firstCell.value = i 'fill the first cell with the counter value
        i = i + 1 'increment the counter
        Do While i <= 40 'loop until the limit is reached
            Set rng = Application.InputBox("Select a cell in column A", "Select a cell", firstCell.Offset(1, 0).Address, Type:=8) 'assign the selected cell to the variable
            If rng.Column = 1 Then 'check if the selected cell is in column A
                rng.value = i 'fill the cell with the counter value
                i = i + 1 'increment the counter
            Else
                MsgBox "Please select a cell in column A only" 'display an error message
            End If
        Loop
    Else
        MsgBox "Please select a cell in column A only" 'display an error message
    End If
End Sub

after that without being prompted, the next number is placed in the cell. Need to limit the total selections to 40 but be able to stop at any time. Ultimately I want to take the results of this and copy the rows selected and paste them on the same worksheet starting in A5 sorted by the numeric values in column A. The code below gives a user prompt for EACH selection and does not allow for stopping until 40 selections are made.

 

[juscuz419]

SelectAndFill is Module based and activated by a control button. The last code above is sheet based and runs whenever I double click on any A cell in a range. Still cant figure out why it is not advancing the numbers. It looks like it should be. I can figure out how to hit the reset when I get his worked out and wrap it in some other functiionality

 

[Micron]

I don't think you're following when you're asked where you put the sheet. Two responders have said it needs to be in the sheet module. Target is not a variable - that indicates you have the code in a standard module, not a sheet module. Works for me with the caveats that I already pointed out

1​
2​
3​
4​
5​
6​
7​
8​
9​
10​
11​
12​
13​	002
14​
15​
16​
17​
18​
19​
20​
21​
22​
23​
24​
25​
26​
27​
28​
29​
30​
31​
32​
33​
34​
35​
36​
37​
38​
39​
40​

 

[juscuz419]

So I put the code below in the sheet. I changed the range to A49:A100 the rows that have data in B through AD. When I double click on any cell in Column A it is putting a 1 in all of them.

[CODE=vba]Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim rng As Range
    Dim pickNum As Long
    Dim totalpicks As Long
    Dim response As Integer
    
Set rng = Range("A49:A100")

If Not Intersect(Target, rng) Is Nothing Then
    Cancel = True
    totalpicks = Application.WorksheetFunction.Count(rng)
    If totalpicks < 40 Then
        pickNum = pickNum + 1
        Target = pickNum
        If Application.WorksheetFunction.Count(rng) = 40 Then
            response = MsgBox("Maximum number of picks has been reached" & vbLf & _
                   "Do you want to run the next step in the process?", vbYesNo, _
                   "Maximum Picks")
            If response = vbYes Then
                'just to show it got here
                MsgBox "call next procedure"
            Else
                'other wise do something else
                MsgBox "Nope don't want to"
            End If
        End If
    End If
End If

End Sub

[ATTACH type="full"]106185[/ATTACH]

[/CODE]

 

[NoSparks]

So I put the code below in the sheet. I changed the range to A49:A100 the rows that have data in B through AD.

you also changed the location of

    Dim pickNum As Long

 

[juscuz419]

Ahh said the blind man. Thought all the Dim statement had to be together. Works as desired. Now on to my next "Opportunity". Thanks

 

[NoSparks]

You're welcome.
I think it would be better to mark post 6 as having the solution.