Find the next empty cell in a column and insert the next sequential number

Question

I need to find the end of a list and then skip to the next cell and enter "Question " + k. Where k is the number of cells with text so far in the column. The worksheet should look like this:

Question 1
Question 2
-------------> Here insert "Question " + count of non-empty cells (Which should return Question 3)

Here is my code in full:

    Option Explicit


Private Sub cmdbtnAddQuestion_Click()

   Worksheets("QuestionsToAnswerBucket").Activate

   If IsEmpty(Range("A7")) Then
            Range("A7").Activate
            ActiveCell = "Question 1"
        ElseIf IsEmpty(Range("B8")) Then
            Range("A8").Activate
            ActiveCell = "Question 2"
        ElseIf IsEmpty(Range("B9")) Then
            Range("A9").Activate
            ActiveCell = "Question 3"
        ElseIf IsEmpty(Range("B10")) Then
            Range("A10").Activate
            ActiveCell = "Question 4"
        ElseIf IsEmpty(Range("B11")) Then
            Range("A11").Activate
            ActiveCell = "Question 5"
        ElseIf IsEmpty(Range("B12")) Then
            Range("A12").Activate
            ActiveCell = "Question 6"
        Else
            Worksheets("QuestionQueue").Activate
            k = Application.WorksheetFunction.CountIf(Range("A2:A200"), "*")

            If IsEmpty(Range("A7")) Then
                Range("A7").Activate
                ActiveCell = "Question 1"
            Else
                Range("A7").End(xlDown).Offset(1, 0).Select
                ActiveCell.Value = "Question " & (k + 1)
                ActiveCell.Font.Bold = True
            End If
        End If

   If txtAddAQuestion.Value = "" Then
            MsgBox "Please Insert A Question"
        Else:
            ActiveCell.Offset(0, 1).Value = txtAddAQuestion.Value
            ActiveCell.Font.Bold = True
        End If
    Unload Me

End Sub

You've redacted your code to the point where it won't compile. What is the second `End If` at the bottom intended to close? Could that be your problem? Does the above code work for you without the second `End If`? — , Oct 11 '15 at 22:05
Hi Jeeped,You're correct, I did take it from a large portion of code. I left the rest out because it all works up until this point. Could something from another portion of the code be messing this up? — Jonh, Oct 11 '15 at 22:54
Hi Portland Runner... I'm getting a run time error 1004 as Jeep mentions below. — Jonh, Oct 11 '15 at 23:05

score 1 · Answer 1 · edited Oct 12 '15 at 11:39

This is my final answer. It seems to work well (6 full tests) - I will continue to test it.

Option Explicit

Private Sub cmdbtnAddQuestion_Click()

   Worksheets("QuestionsToAnswerBucket").Activate

   If IsEmpty(Range("B7")) Then
            Range("A7").Activate
            ActiveCell = "Question 1"
        ElseIf IsEmpty(Range("B8")) Then
            Range("A8").Activate
            ActiveCell = "Question 2"
        ElseIf IsEmpty(Range("B9")) Then
            Range("A9").Activate
            ActiveCell = "Question 3"
        ElseIf IsEmpty(Range("B10")) Then
            Range("A10").Activate
            ActiveCell = "Question 4"
        ElseIf IsEmpty(Range("B11")) Then
            Range("A11").Activate
            ActiveCell = "Question 5"
        ElseIf IsEmpty(Range("B12")) Then
            Range("A12").Activate
            ActiveCell = "Question 6"
        Else
            Worksheets("QuestionQueue").Activate
            **k = Application.CountIf(Cells, "Question *")

            If IsEmpty(Range("B7")) Then
                Range("A7").Activate
                ActiveCell = "Question 1"
            Else
                Range("A7").Offset(k, 0).Activate
                ActiveCell.Value = Format(k + 1, "\Qu\e\stio\n 0")**
                ActiveCell.Font.Bold = True
            End If
        End If

   If txtAddAQuestion.Value = "" Then
            MsgBox "Please Insert A Question"
        Else:
            ActiveCell.Offset(0, 1).Value = txtAddAQuestion.Value
            ActiveCell.Font.Bold = True
        End If
    Unload Me

End Sub

score 0 · Accepted Answer · edited May 23 '17 at 12:15

The problem you are having is that on the second pass you are taking the .End(xlDown) from the occupied A7 cell. However, if there is nothing in A8:A1048576, you are going to A1048576 and then trying to use the Range .Activate method to select the cell below that. There is no cell below that so you receive the

Runtime error: 1004.
Application-defined or object-defined error.

Try something closer to one of these.

Option 1 (very different approach):

Sub AddQuestionQueue()
    Dim k As Long

    With Worksheets("QuestionQueue")
        With Range("A2:A" & Rows.Count)
            k = Application.CountIf(.Cells, "Question *")
        End With
        With .Range("A7").Offset(k, 0)
            .Value = Format(k + 1, "\Qu\e\stio\n 0")
            .Font.Bold = True
        End With
    End With

End Sub

Option 2 (closer to your original):

Sub AddQuestionQueue_orig()
    Dim k As Long, r As Long

    With Worksheets("QuestionQueue")
        r = .Cells(Rows.Count, 1).End(xlUp).Row + 1
        k = Application.CountIf(.Range("A7:A" & Rows.Count), "Question *")

        With .Range("A" & Application.Max(r, 7))
            .Value = "Question " & (k + 1)
            .Font.Bold = True
        End With
    End With

End Sub

Typically, it is better to look for the last occupied cell coming from the bottom up (e.g. .Cells(Rows.Count, 1)>End(xlUp)) than from the bottom down. In the first option above, a simple Range.Offset using the number of previous questions allowed one routine for all; not a separate one for a blank A7. The second option is closer to your own code but looks from the bottom up with a minimum row number of 7.

See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.

Hi Jeeped, thanks for your response. I'm not sure that I understand any of your code. It seems to lock all of my cells in excel. Also why is "\qu\e\stio\n 0" written with the slashes? I've put my full code so that maybe it will make more sense? — Jonh, Oct 11 '15 at 23:03
@John - There must be something in the larger picture that is causing that freeze and I will look at your new edit. See my own above that is closer to yours but looks from the bottom up for the next blank row in column. — , Oct 11 '15 at 23:09
The `"\qu\e\stio\n 0"` is simply a way to write *Question 1, Question 2, etc.* The backslashes are to make some characters literal; e.g. **s** would otherwise be interpreted as *seconds*, **Q** as yearly quarters just as **mmm** gives us *Jan, Feb, etc.* — , Oct 11 '15 at 23:13
Hi Jeeped, I have to apologize! Your response worked. I will go on to read the link you provided. but in the meantime, I was able to take what you wrote and change it to fit the activate method that I'm use to. In the past I've entered words and didn't have to use the "\". What would indicate needing to use this? Thanks again! Super grateful :-) — Jonh, Oct 11 '15 at 23:14

Find the next empty cell in a column and insert the next sequential number

2 Answers2