Yet another version

Public Sub AddRws(Val as string, ColumnNum as integer

Dim x, LstVal, y As Integer, Cnt As Integer, CbxVal As Integer, FrstVal As Strin
CbxVal = CInt(Cbx.Value
Range("A1").EntireRow.Inser
With ActiveSheet.Columns(ColumnNum
..Cells(1).Selec
Set x = .Find(What:=Val, After:=ActiveCell, LookIn:=xlValues, LookAt:=
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True
If Not x Is Nothing The
Cnt = Cnt +
FrstVal = x.Addres
D
Set LstVal =
Set x = .FindNext(x
Cnt = Cnt +
Loop While Not x Is Nothing And x.Address < FrstVa
Cnt = Cnt -
If Cnt < CbxVal The
Range(LstVal.Address).Offset(1, 0).Selec
For y = 1 To CbxVal - Cn
ActiveCell.EntireRow.Inser
Nex
End I
End I
End Wit
Range("A1").EntireRow.Delet
End Su