Insert rows if it meets the criterias

[vane0326]

Can we insert rows by criteria? Look at the example I put below it insert 3 rows. If the machine appears more than 2 or more and in collumn and in collumn (B) has a Shift # 1 so if in Collumn (A) 6,7,8 or more has the same name AND in collumn (B) has the same Shift number then insert 3 rows BUT if the name are different then insert one row beneath them OR if in collumn (A) has the same name AND Collumn (B) has different Shift numbers then only insert one row.
A Note When you see (A) & (B) those are collumns And the numbers 1 & 2 are in collumn (B)

(A) --------------------------(B)
HUNTER-2 ( LARGE 20X24 ) 1
Insert row

BUT!

If it looks like this:

(A) --------------------------(B)
HUNTER-2 ( LARGE 20X24 ) 1
HUNTER-2 ( LARGE 20X24 ) 1
insert row
insert row
insert row

OR

(A) --------------------------(B)
HUNTER-2 ( LARGE 20X24 ) 1
HUNTER-2 ( LARGE 20X24 ) 1
HUNTER-2 ( LARGE 20X24 ) 1
HUNTER-2 ( LARGE 20X24 ) 1
Insert row
insert row
insert row

OR

(A)-------------------------- (B)
HUNTER-2 ( LARGE 20X24 ) 2
HUNTER-2 ( LARGE 20X24 ) 2
Insert row
Insert row
Insert row

Now if it looks like this the code should do this:

(A) --------------------------(B)
HUNTER-2 ( LARGE 20X24 ) 1
Insert Row
HUNTER-2 ( LARGE 20X24 ) 2
HUNTER-2 ( LARGE 20X24 ) 2
Insert Row
Insert Row
Insert Row
HUNTER-4 ( LARGE 20X24 ) 1
Insert Row

OR

(A)-------------------------- (B)
HUNTER-2 ( LARGE 20X24 ) 1
HUNTER-2 ( LARGE 20X24 ) 1
Insert Row
Insert Row
Insert Row
HUNTER-3 ( LARGE 20X24 ) 2
Insert Row
HUNTER-4 ( LARGE 20X24 ) 2
HUNTER-4 ( LARGE 20X24 ) 2
Insert Row
Insert Row
Insert Row
HUNTER-2 ( LARGE 20X24 ) 1


I got this code from the forum but it only does so much.
Here is what happens when I run this code.

Sub Isertby_Criteria()

yRows = 3
lastRow = [A65536].End(xlUp).row
For i = lastRow - 1 To 2 Step -1
If Range("A" & i) = Range("A" & i + 1) Then GoTo Continue1
yCount = WorksheetFunction.CountIf(Range("A2:A" & i + 1), Range("A" & i))
If yCount = 1 Then
Range("A" & i + 1).EntireRow.Insert
End If
If yCount > 1 Then
Range("A" & i + 1, "A" & i + yRows).EntireRow.Insert
End If
Continue1:
Next i
End Sub

Thanks!

 

[jindon]

Hi
try the code
assuming the data begins from A1

Sub InsertRow()
Dim i As Long
Application.ScreenUpdating = False
With ActiveSheet
    i = 2
    Do While .Cells(i, 1) <> ""
        Select Case .Cells(i, 2).Value
            Case Is = .Cells(i - 1, 2).Value
                If .Cells(i + 1, 2) <> .Cells(i, 2) Then
                    .Rows(i + 1 & ":" & i + 3).Insert
                    i = i + 3
                End If
            Case Is <> .Cells(i - 1, 2).Value
                If Not IsEmpty(.Cells(i - 1, 2)) Then
                    .Rows(i).Insert
                End If
        End Select
        i = i + 1
    Loop
End With
Application.ScreenUpdating = True
End Sub

hope this helps
jindon

 

[vane0326]

Your code almost did it this what it did!

QDESC---------------------------JSHIFT
HUNTER-1 ( LARGE 20X24 )------1
HUNTER-1 ( LARGE 20X24 )------1
Insert row
Insert row
Insert row
HUNTER-1 ( LARGE 20X24 )------2
Insert row
HUNTER-2 ( LARGE 20X24 )------1
insert row
HUNTER-2 ( LARGE 20X24 )------2
HUNTER-2 ( LARGE 20X24 )------2
HUNTER-2 ( LARGE 20X24 )------2
HUNTER-2 ( LARGE 20X24 )------2
HUNTER-3 ( SMALL 14X19 )------2
Insert row
Insert row
Insert row
HUNTER-4 ( SMALL 14X19 )------1
HUNTER-4 ( SMALL 14X19 )------1
ROTO-LIFT------------------------1
Insert row
Insert row
Insert row
SHELL MOLD ( CHICKOPEE )------2
Insert row
SINTO------------------------------1
SINTO------------------------------1
SINTO------------------------------1
SQUEEZER--------------------------1


SHELL MOLD ( CHICKOPEE )------2

SINTO------------------------------1
SINTO------------------------------1
SINTO------------------------------1
SQUEEZER--------------------------1


Can you modified it to do this?

QDESC---------------------------JSHIFT
HUNTER-1 ( LARGE 20X24 )------1
HUNTER-1 ( LARGE 20X24 )------1
Insert row
Insert row
Insert row
HUNTER-1 ( LARGE 20X24 )------2
Insert row
HUNTER-2 ( LARGE 20X24 )------1
insert row
HUNTER-2 ( LARGE 20X24 )------2
HUNTER-2 ( LARGE 20X24 )------2
HUNTER-2 ( LARGE 20X24 )------2
HUNTER-2 ( LARGE 20X24 )------2
Insert row
Insert row
Insert row
HUNTER-3 ( SMALL 14X19 )------2
Insert row
HUNTER-4 ( SMALL 14X19 )------1
HUNTER-4 ( SMALL 14X19 )------1
Insert row
Insert row
Insert row
ROTO-LIFT ------------------------1
Insert row
SHELL MOLD ( CHICKOPEE )------2
Insert row
SINTO------------------------------1
SINTO------------------------------1
SINTO------------------------------1
Insert row
Insert row
Insert row
SQUEEZER--------------------------1


SHELL MOLD ( CHICKOPEE )------2

SINTO------------------------------1
SINTO------------------------------1
SINTO------------------------------1
SQUEEZER--------------------------1

 

[jindon]

Hi

try this

Sub InsertRow()
Dim i As Long, x As String, y As String, z As String
Application.ScreenUpdating = False
With ActiveSheet
    i = 2
    Do While .Cells(i, 1) <> ""
        x = .Cells(i - 1, 1) & .Cells(i - 1, 2)
        y = .Cells(i, 1) & .Cells(i, 2)
        z = .Cells(i + 1, 1) & .Cells(i + 1, 2)
        Select Case y
            Case Is = x
                If y <> z Then
                    .Rows(i + 1 & ":" & i + 3).Insert
                    i = i + 4
                End If
            Case Is <> x
                    .Rows(i).Insert
                    i = i + 1
        End Select
        i = i + 1
    Loop      
End With
Application.ScreenUpdating = True
End Sub

rgds,
jindon

 

[vane0326]

Thank You so much it Works