Auto-Sequencing when Adding a Row

[JPhotonics]

I have a spreadsheet where users will select answers to questions, however, these users may also want to ADD a new question (ROW). How can I make it so that I can have a cell to the left (for example A16) be numbered 1 and then any numbers after it follow in sequential order? The standard form/template has Cells A16 through A18 as questions, numbered 1, 2 and 3. There will be other subsets of questions also, but they are all in 3-question standard groupings.

Currently, in order to keep the formulas and drop-down answers for the questions, the user must copy the row and insert it. This keeps the formatting correct for the row and allows the questions to be answered and post results properly. However, it does not automatically sequence the question number. So, the user winds up with 1, 2, 2, 3 for example. Is there a formula I can put in the cell(s) to auto-sequence if the user copies and inserts the formula to create a new Row (question)?

I have attached a sample of the worksheet. You will notice that it is a Macro-Enabled Worksheet because I am running some code to allow me to timestamp when all questions become "Approved" or "Approved w/ Comments". If it would work best to put in more code for the auto-sequencing, that would be fine, but if that is the case, I would prefer users NOT have to copy and insert.

 

[JPhotonics]

If I am to use VBA, do I need to define all cells where I want this auto-sequencing to occur? I have included a 2nd file with 2 groupings of questions to see how this would work.
__________________________________________________________________

Mod edit : thread moved to appropriate forum !​

 

[narunfca]

Try the following code. Insertion only one row at a time.

with best regards

Arun N

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address <> "$D$7" And Mid(Target.Address, 6, 1) <> ":" Then

If ActiveCell.Offset(1, 1).Text = "Not Applicable" Then
ActiveCell.Offset(-1, 0).Copy
ActiveCell.Range("a1:a2").PasteSpecial (xlPasteAll)
Application.CutCopyMode = False
End If

If Range("C7").Text = "Approved" Or Range("C7").Text = "Approved w/ Comments" Then
If Range("$D$7").Text = "" Then
Range("D7").FormulaR1C1 = "=NOW()"
Range("D7").Copy
Range("D7").PasteSpecial (xlPasteValues)
ActiveCell.Select
End If
Else
Range("D7").FormulaR1C1 = ""
End If
End If

End Sub

 

[JPhotonics]

Try the following code. Insertion only one row at a time.

with best regards

Arun N

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address <> "$D$7" And Mid(Target.Address, 6, 1) <> ":" Then

If ActiveCell.Offset(1, 1).Text = "Not Applicable" Then
ActiveCell.Offset(-1, 0).Copy
ActiveCell.Range("a1:a2").PasteSpecial (xlPasteAll)
Application.CutCopyMode = False
End If

If Range("C7").Text = "Approved" Or Range("C7").Text = "Approved w/ Comments" Then
If Range("$D$7").Text = "" Then
Range("D7").FormulaR1C1 = "=NOW()"
Range("D7").Copy
Range("D7").PasteSpecial (xlPasteValues)
ActiveCell.Select
End If
Else
Range("D7").FormulaR1C1 = ""
End If
End If

End Sub

That does not appear to work. If I copy and insert the row, it inserts the row just as it did before, with no auto-sequencing (see screenshot #1 below). Then, if I hit CTRL+Z to undo, it switches all of my Question #'s from 1, 2, 3 to 1, 1, 1 and copies the border formatting as well, making them all bold (see screenshot #2 below). Also, when first selecting "Approved" or "Approved w/ Comments" and displaying the timestamp, it is highlighting the cell with a checked box like it is copying the cell preparing to paste it somewhere else (see screenshot #3 below). This isn't a huge problem, just a difference I noticed.

#1


#2


#3

 

[narunfca]

Enclosed the revised code.
Tested. Works fine.
Please insert or delete the entire row to activate.

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address <> "$D$7" Then
If Mid(Target.Address, Len(Format(Target.Row, "0")) + 2, 1) = Chr(58) Then
ActiveCell.Offset(-1, 0).Copy
ActiveCell.Range("a1:a2").PasteSpecial (xlPasteAll)
Application.CutCopyMode = False
ActiveCell.Select
End If

If Range("C7").Text = "Approved" Or Range("C7").Text = "Approved w/ Comments" Then
If Range("$D$7").Text = "" Then
Range("D7").FormulaR1C1 = "=NOW()"
Range("D7").Copy
Range("D7").PasteSpecial (xlPasteValues)
ActiveCell.Select
End If
Else
Range("D7").FormulaR1C1 = ""
End If
End If

End Sub

 

[JPhotonics]

Enclosed the revised code.
Tested. Works fine.
Please insert or delete the entire row to activate.

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address <> "$D$7" Then
If Mid(Target.Address, Len(Format(Target.Row, "0")) + 2, 1) = Chr(58) Then
ActiveCell.Offset(-1, 0).Copy
ActiveCell.Range("a1:a2").PasteSpecial (xlPasteAll)
Application.CutCopyMode = False
ActiveCell.Select
End If

If Range("C7").Text = "Approved" Or Range("C7").Text = "Approved w/ Comments" Then
If Range("$D$7").Text = "" Then
Range("D7").FormulaR1C1 = "=NOW()"
Range("D7").Copy
Range("D7").PasteSpecial (xlPasteValues)
ActiveCell.Select
End If
Else
Range("D7").FormulaR1C1 = ""
End If
End If

End Sub

Perhaps I am doing something wrong, but this still does not appear to be working correctly. I tried both just inserting a row and tried copying and inserting. Neither works properly. Then, if I go to delete that new row I've added, it resets all of the #'s to 1 instead of keeping 1, 2, 3.

Also, it is still creating that highlighted box around D7 when "Approved" or "Approved w/ Comments" is shown. It was not doing this initially.

Here are the outputs I get:

Copying and inserting:


Only inserting a new row:


Deleting the newly inserted row:

 

[narunfca]

Hi!

Found out the real reason, Why it worked for me and not you.

I was selecting cell in column A while inserting and was copying formula from the cell above to the current cell. Your active cell was on different column.

Compensated the same in coding and revised code is given below.

However, entire row to be inserted or deleted or copied for the code to work.

with best regards
Arun N

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address <> "$D$7" Then
  If Mid(Target.Address, Len(Format(Target.Row, "0")) + 2, 1) = Chr(58) Then
    Selection.End(xlToLeft).Select
    ActiveCell.FormulaR1C1 = "=R[-1]C+1"
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C+1"
    ActiveCell.Offset(1, 0).Range("A1").Select
  End If

  If Range("C7").Text = "Approved" Or Range("C7").Text = "Approved w/ Comments" Then
    If Range("$D$7").Text = "" Then
      Range("D7").FormulaR1C1 = "=NOW()"
      Range("D7").Copy
      Range("D7").PasteSpecial (xlPasteValues)
      ActiveCell.Select
    End If
  Else
    Range("D7").FormulaR1C1 = ""
  End If
End If

End Sub