Insert row based on first digit in cell

youngeli

New Member
Hello,

I have a sheet with a series of 4 digit numbers in column A. These numbers start out above 1000, and then move through the 2000's, 3000's, etc. They do not exceed 9999. I'm looking to insert a row when the first digit increases, so I can visually group these numbers together by thousands, two thousands, etc.

The code I have right now is definitely not working for me:

Code:
``````Sub AddLine()
Dim d As Integer
Dim a As Integer
d = Range("A:A").End(xlDown).Row
a = 1
Dim c As Range
For i = d To 1 Step -1
If Left(Cells(i, 1), 1) = a Then
Rows(Cells(i + 1, 1).Row).Insert shift:=xlDown
a = a + 1
End If
Next
End Sub``````

After I get this working, my next step is to insert text into the newly created row. I haven't even bothered to attempt that yet. Any help you can provide would be greatly appreciated! Thanks.

Last edited:

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},\$Z\$1:\$Z\$99,\$Y\$1:\$Y\$99),2,False) to lookup Y values to left of Z values.
Try this...

Code:
``````Sub AddLine()
Dim lEnd As Long
Dim rData As Range
Dim lL As Long
Application.ScreenUpdating = False
lEnd = Cells(Rows.Count, 1).End(xlUp).Row
Set rData = Range("A1", "A" & lEnd)
Range("A1", "A" & lEnd).Sort Key1:=Cells(1), Header:=xlNo
For lL = lEnd To 2 Step -1
If Left(Cells(lL, 1), 1) <> Left(Cells(lL - 1, 1), 1) Then
Range(Cells(lL, 1), Cells(lL + 1, 1)).EntireRow.Insert
Cells(lL + 1, 1).Value = "Group number " & Left(Cells(lL + 2, 1), 1)
End If
Next
Cells(1, 1).EntireRow.Insert
Cells(1, 1).Value = "Group number 1"
Application.ScreenUpdating = True
End Sub``````

 1997 1998 1999 2000 macro has found the gap and inserted a row 2001 2002 easy to put text into the new epmpty row 2003 note that formatting on the post ia a bit scewed up For j = 1 To 20 original If Cells(j, 1) = "" Then GoTo 100 data leftchar1 = Left(Cells(j, 1), 1) leftchar2 = Left(Cells(j + 1, 1), 1) 1997 If leftchar1 = leftchar2 Then GoTo 100 1998 Cells(j + 1, 1).Select 1999 Selection.EntireRow.Insert 2000 100 Next j 2001 End Sub 2002 2003

<tbody>
</tbody>

Replies
0
Views
137
Replies
5
Views
202
Replies
7
Views
386
Replies
29
Views
807
Replies
10
Views
757

1,203,401
Messages
6,055,182
Members
444,768
Latest member
EMGVT

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back