Insert number of rows based on criteria

[S Davis]

Hello,

Is there any way to insert a number of rows based on criteria?

Sample data:
A------------S---T---U-....
Bill---------(_)-(X)-(_)
Bob--------(_)-(_)-(_)
Joe---------(X)-(X)-(X)
Murph ....

(Where (_) denotes a blank cell)

Desired presentation:

Bill---------(_)-(X)-(_)
(blank row)
Bob--------(_)-(_)-(_)
Joe---------(X)-(X)-(X)
(blank row)
(blank row)
(blank row)
Murph ....

I have a list of names in column A, and a list of criteria names in S1
- Z1. For each name (ie. Bill), criteria is defined as met with any
marking in that column (ie. T1 = "X", or "o", or anything nonblank)

What I would like to do then is for every row, look at the range S-Z,
count the number of nonblank cells, and then insert that number of
nonblank rows directly underneath. Then move onto the next name until
the list is exhausted.

Ideally, though this may be asking too much, each row that is inserted
should then have the name of the criteria inserted into AA. So, for
instance, in the sample data above, if Bill has an X under column T,
and T1 reads "Car", the data should look like this:

A------------S---T---U-....AA
Bill---------(_)-(X)-(_)
---------------------------....Car
Bob....


Any help and a walkthrough of the code would be so much appreciated!
Thanks

 

[Chip Pearson]

Try some code like the following:

Sub AAA()
Dim RowNdx As Long
Dim LastRow As Long
Dim N As Long
Dim J As Long
Dim FirstRow As Long
Dim WS As Worksheet
Dim R As Range
Set WS = Worksheets("Sheet1") '<<< CHANGE TO WORKSHEET
FirstRow = 1 '<<< CHANGE TO FIRST ROW OF DATA
With WS
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
For RowNdx = LastRow To FirstRow Step -1
Set R = WS.Cells(RowNdx, "S")
N = Application.CountA(R.EntireRow.Cells(1, "S").Resize(1, 8))
For J = 1 To N
R(2, 1).EntireRow.Rows.Insert
Next J
Next RowNdx
End Sub

Change the lines marked with <<< to values appropriate to your
worksheet.

Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group, 1998 - 2009
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)

 

[Otto Moehrbach]

In your last paragraph, the one where you ask about inserting the name of
the criteria into Column AA, would "Joe" then have a different criteria
name in Column AA in each of the 3 inserted rows? Otto

 

[RadarEye]

Hello,

Is there any way to insert a number of rows based on criteria?

Sample data:
A------------S---T---U-....
Bill---------(_)-(X)-(_)
Bob--------(_)-(_)-(_)
Joe---------(X)-(X)-(X)
Murph ....

(Where (_) denotes a blank cell)

Desired presentation:

Bill---------(_)-(X)-(_)
(blank row)
Bob--------(_)-(_)-(_)
Joe---------(X)-(X)-(X)
(blank row)
(blank row)
(blank row)
Murph ....

I have a list of names in column A, and a list of criteria names in S1
- Z1. For each name (ie. Bill), criteria is defined as met with any
marking in that column (ie. T1 = "X", or "o", or anything nonblank)

What I would like to do then is for every row, look at the range S-Z,
count the number of nonblank cells, and then insert that number of
nonblank rows directly underneath. Then move onto the next name until
the list is exhausted.

Ideally, though this may be asking too much, each row that is inserted
should then have the name of the criteria inserted into AA. So, for
instance, in the sample data above, if Bill has an X under column T,
and T1 reads "Car", the data should look like this:

A------------S---T---U-....AA
Bill---------(_)-(X)-(_)
---------------------------....Car
Bob....

Any help and a walkthrough of the code would be so much appreciated!
Thanks

Hi Bob,

In Excel2003 I have created the following:

Sub CreteriaLines()
' Declare contsants
Const cS As Integer = 19 ' for column S
Const cZ As Integer = 26 ' for column Z
Const cA As Integer = 1 ' for column A
Const cAA As Integer = 27 ' for column AA
' Declare variables
Dim lRs As Long ' for source row
Dim lRd As Long ' for destination row
Dim iCr As Integer ' for number for creteria
Dim rCr As Range ' for temporary range defenition
Dim iLp As Integer ' for looping column S to Z

' set source row and destination row
lRs = 1
lRd = 2

Do
Set rCr = Range(Cells(lRs, cS), Cells(lRs, cZ))
' count number of non blank cells
iCr = WorksheetFunction.CountA(rCr)
If iCr > 0 Then
' insert empty lines
Range(Cells(lRd, cA), Cells(lRd + iCr - 1,
cA)).EntireRow.Insert _
shift:=xlDown
' loop columns S to Z
For iLp = cS To cZ
' if the cell if not empty
If Not IsEmpty(Cells(lRs, iLp)) Then
' copy the value to column AA of inserted line
Cells(lRd, cAA).Value = Cells(lRs, iLp)
' zet destination row 1 down
lRd = lRd + 1
End If
Next
End If
' reset source row and destination row
lRs = lRd
lRd = lRs + 1
Loop Until IsEmpty(Cells(lRs, cA))
End Sub


HTH,

Wouter

 

[S Davis]

Chip, thank you! Sorry I didn't get back to this earlier. Africa....
internet.....

Anyway, I appreciate it. This works great. I'm wondering what needs to
be done, though, to get it to the next step.

Currently I can run this macro and it transforms the sheet. Perfect.
However, is there any way for this to work in real-time? Say I add an
x to a row, or delete an x - is there any way that when adding or
deleting it can insert or take away rows on the fly?

 

[S Davis]

In your last paragraph, the one where you ask about inserting the name of
the criteria into Column AA, would "Joe" then  have a different criteria

Otto, yes. If S = Car, T= Bike, U = Van, then it would read:

Bill---------(_)-(X)-(_)
(blank row)-----------Bike
Bob--------(_)-(_)-(_)
Joe---------(X)-(X)-(X)
(blank row)-----------Car
(blank row)-----------Bike
(blank row)-----------Van
Murph ....

 

[keiji kounoike]

Try this one.
Sub TestInsert()
Dim start As Long
Dim startcell As Range, lastcell As Range, nextcell As Range
Dim lookrng As Range, tmp As Range

On Error Resume Next

Application.ScreenUpdating = False

Set tmp = Nothing
Set tmp = Columns("AA").SpecialCells(xlCellTypeConstants)
If Not tmp Is Nothing Then
tmp.EntireRow.delete
End If

start = 1
Set lookrng = Range(Cells(start, "S"), Cells(start, "Z"))
Set startcell = Cells(start, "A")
Set lastcell = Cells(Cells.Rows.Count, "A").End(xlUp)
Set nextcell = startcell.Offset(1, 0)
Do While (startcell.Row <= lastcell.Row)
Set tmp = Nothing
Set tmp = lookrng.SpecialCells(xlCellTypeConstants)
If Not tmp Is Nothing Then
For Each rng In tmp
nextcell.EntireRow.Insert
Cells(nextcell.Row - 1, "AA") = rng.Value
Next
End If
Set startcell = nextcell
Set nextcell = startcell.Offset(1, 0)
start = startcell.Row
Set lookrng = Range(Cells(start, "S"), Cells(start, "Z"))
Loop

End Sub

Besides, if you want the result on the fly, you could use
Worksheet_Change event. put the code the like the following in
worskheetcode module where your data reside.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
TestInsert
Application.EnableEvents = True
End Sub

TestInsert is the sub already described above. But if you have many
data, this would not work so fast to satisfy your demand.

keiji