Inserting rows based on count

[Mike]

I need a macro that can count how many rows have a certain
value(lets say "1") in column "I" and then inset rows
based on the selected value(lets say "12") of a combobox
minus the count of rows.

Example: 5 rows have a value of 1 in column "I" and 12 is
the value of the combobox = 7 rows to be inserted after
the last row that has the value 1 in column "I".

If 24 is the selected combobox value, 19 rows have to be
inserted after the last row that has the value 1 in
column "I".

This is a bit beyond my knowledge so any help is
appreciated.

Mike

 

[Bob Phillips]

Hi Mike,

numrows = Combox1.Value - WorksheetFunction.CountIf(Columns("I:I"), 1)
Cells(Rows.Count, "I").End(xlUp).Offset(1, 0).Resize(numrows,
1).EntireRow.Insert

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Ron de Bruin]

Hi

Different as Bob's example

Who is right????


Sub Find_test()
Dim FindString As String
Dim Rng As Range
Dim num As Long

FindString = "1"
num = Application.WorksheetFunction.CountIf(Range("I:I"), FindString)

Set Rng = Range("I:I").Find(What:=FindString, _
After:=Range("A1"), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If Not Rng Is Nothing Then
Rows(Rng.Row + 1).Resize(Combox1.Value - num).EntireRow.Insert
End If
End Sub

 

[Ron de Bruin]

After:=Range("A1"), _

must be

After:=Range("I1"), _

 

[Guest]

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

 

[Guest]

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

 

[Bob Phillips]

or two<vbg>

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)