VBA - put value in each empty row created - vba

Question

I have a vba code that creates empty row after each row with value:
Row 1
Row 2
Row 3
Output
Row 1
Row 2
Row 3
In the empty rows I want to insert value "check1", "check2", the auto increment of "check" and "autonumber"
To get a final output of the below:
Row 1
check1
row 2
check2
row n
check n
here is the code I have started:
Sub Insert_Blank_Rows()
'Select last row in worksheet.
Selection.End(xlDown).Select
Do Until ActiveCell.Row = 1
'Insert blank row.
ActiveCell.EntireRow.Insert shift:=xlDown
'Move up one row.
ActiveCell.Offset(-1, 0).Select
Loop
End Sub

Answer 1

Here's a quick and easy and efficient way with only minimal adjustment to your current code.
Sub Insert_Blank_Rows()
Dim rng as Range
Set rng = Selection ' grab top most cell in range, you may want to actually refer to the actual cell.
rng.End(xlDown).Select 'Select last row in worksheet.
Do Until ActiveCell.Row = 1
'Insert blank row.
ActiveCell.EntireRow.Insert shift:=xlDown
'Move up one row.
ActiveCell.Offset(-1, 0).Select
Loop
'fill blanks with incremental checks
Dim rngBottom as Range
Set rngBottom = Cells(rows.Count,rng.Column).End(xlUp).Offset(1)
Range(rng, rngBottom).SpecialCells(xlCellTypBlanks).FormulaR1C1 = "=""Check""&ROW()/2"
End Sub

Answer 2

I'll throw in this solution, with no looping nor inserting
it's very fast (less than 1 second for 20k rows)
Option Explicit
Sub main()
Dim helperCol As Range
With ActiveSheet.UsedRange
Set helperCol = .Columns(.Columns.Count + 1)
End With
With Range(ActiveCell, ActiveCell.End(xlDown))
.Offset(, helperCol.Column - .Column).Formula = "=ROW()"
With .Offset(.Rows.Count)
.Formula = "=CONCATENATE(""check"",ROW()-" & .Rows.Count & ")"
.Value = .Value
With .Offset(, helperCol.Column - .Column)
.Formula = "=ROW()-" & .Rows.Count & "+ 0.1"
.Value = .Value
End With
End With
.Resize(2 * .Rows.Count, helperCol.Column - .Column + 1).Sort Key1:=helperCol.Resize(2 * .Rows.Count), Header:=xlNo
helperCol.Resize(2 * .Rows.Count).Clear
End With
End Sub
as per OP's request, it takes move from ActiveCell

Answer 3

So every other row is empty and you want to fill it? One way would be something like
finalRow = cells(1000000,1).end(xlup).row
yourIncrement = 1
for i = 1 to finalRow
if isempty(cells(i,1)) then
cells(i,1) = "check" & yourIncrement
yourIncrement = yourIncrement + 1
end if
next i
I am assuming your want to fill column 1 (A).

Answer 4

How's this?
Sub Insert_Blank_Rows()
Dim lastRow&, i&
'Assuming column A has the most data (if not change the `1` to whatever column # does have the most data
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
'Select last row in worksheet.
'Selection.End(xlDown).Select ' Don't use `.Select`
i = 2
Do While i <= lastRow
Rows(i).Select
Rows(i).EntireRow.Insert shift:=xlDown
Cells(i, 1).Value = "Check " & Cells(i - 1, 1).Value
Cells(i, 1).Value = Cells(i, 1).Value
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
i = i + 2
Loop
End Sub

Answer 5

Here, I got one for you. I already tested it and work well for requirement.
Which is special in my code? My code will miss no row. Perfect auto-increment.
And I also reference from BruceWayne's code because I don't want to edit his own code.
Sub checkingData()
Dim exeRow As Integer 'For indexing the executing row
Dim lastRow As Integer 'For storing last row
exeRow = 2 'Checking from first row
'Assume that First Column has more data row than Other Column
lastRow = Cells(Rows.Count, 1).End(xlUp).row
'Loop from First Row to Last Row
Do While exeRow <= lastRow + 1
'Select data row
Rows(exeRow).Select
'Insert row below data row
Rows(exeRow).EntireRow.Insert shift:=xlDown
'Set auto-increment result
Cells(exeRow, 1) = "Check " & (exeRow / 2)
'Increase lastRow count because of adding blank row
lastRow = lastRow + 1
'Go to next data row
exeRow = exeRow + 2
Loop
End Sub