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.

 

[Micron]

You don't want to run that sub with every cell click because i will restart at 1 every time. You need to declare a module level variable for i so that it can hold its value when the sub terminates and still increment to 40. Not sure, but I think your logical test would be 'prompt if i=0; don't prompt if >0, just write i+1 to the target cell and make i that new value '

 

[juscuz419]

It actually places a 1 in the first cell , prompts for the next cell and places a 2, prompts for the next cell and places a 3 etc. want to find a way to just prompt on the first click then have every click after that put the next number in.

 

[Micron]

I think I understood what it does. I'm suggesting something like this (but if it's close it needs tweaking - see comment after code)

Option Explicit
Dim intX As Long

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range 'declare a variable to store the selected cell

If Target.Column = 1 Then
    Set rng = Application.InputBox("Select the first cell in column A", Type:=8) 'assign the first cell to the variable
    Do Until intX = 40
        intX = intX + 1
        rng = intX
        Set rng = rng.Offset(1, 0)
    Loop
End If

End Sub

First 2 lines should be at the very top.
What it probably would need:
- to deal with the issue where user cancels the input OR user does not select a cell.
- what should happen if user clicks in cell below 40? Currently it will do nothing if intX is 40 so you may need a reset of intX

 

[juscuz419]

The code throws an error that the variable "Target" has not been defined.

 

[NoSparks]

I would use a double click in the cells

With a test range limited to A6:A30 and the maximum selections to 4 this is what I came up with.
This is event code so needs to be located in the sheet module (right click the sheet tab, select View Code)

Option Explicit

    Dim pickNum As Long

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim rng As Range
    Dim totalpicks As Long
    Dim response As Integer
    
Set rng = Range("A6:A30")

If Not Intersect(Target, rng) Is Nothing Then
    Cancel = True
    totalpicks = Application.WorksheetFunction.Count(rng)
    If totalpicks < 4 Then
        pickNum = pickNum + 1
        Target = pickNum
        If Application.WorksheetFunction.Count(rng) = 4 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

Private Sub resetPickNum()
'quick reset for when testing over and over
    Range("A6:A30").Cells = ""
    pickNum = 0
End Sub

 

[Micron]

The code throws an error that the variable "Target" has not been defined.

Where did you put it? Has to be in the sheet module, not a standard module.

 

[juscuz419]

Where and how do I define the variable TARGET

 

[juscuz419]

Had to step away. The last code places a 1 in every cell in column A that I double click. Why is it not putting sequential numbers on each subsequent double click? Also, how does the reset sub get initialed?

 

[NoSparks]

How would you like to initiate it?
How do you initiate your Sub SelectAndFill procedure?

When coding I'm always in the VBE so I just put the cursor in it and hit F5.
If you want it in the Alt+F8 dialogue just remove the word Private that's in front of Sub.
In actual use it would be run as a call from some procedure.