Sub Zeile_einfügen()
Dim sh As Worksheet, lastRow As Long, rngOO As Range, Fnd1 As Range
Dim i As Long, Count As Long, arr, dict As Object
Count = Application.InputBox(Prompt:="How many row?", Default:=2)
Txt1E= Application.InputBox(Prompt:="1st Item Number?")
Txt2E= Application.InputBox(Prompt:="2nd Item Number?")
Txt1P= Application.InputBox(Prompt:="1st Kommentar_2?")
Txt2P= Application.InputBox(Prompt:="2nd Kommentar_2?")
Set sh = ActiveSheet
lastRow = sh.Range("O" & sh.Rows.Count).End(xlUp).Row
Set rngOO = sh.Range("O3:O" & lastRow)
arr = rngOO.Value
Set dict = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(arr)
If arr(i, 1) <> "" Then dict(arr(i, 1)) = Empty
Next i
For i = 0 To dict.Count - 1
Set Fnd1 = rngOO.Find(dict.Keys()(i), , , xlWhole, xlByRows, xlPrevious, False, , False)
Fnd1.EntireRow.Copy
sh.Range(Fnd1.Offset(1, 0), Fnd1.Offset(Count, 0)).EntireRow.Insert Shift:=xlDown
Next i
MsgBox (Count & " Row/s are added")
End Sub