changing of code

[Andries]

Hi

Can somebody please help me with this code below. Currently it is looking at a value that is greater than 1 and then it duplicates the entire row underneath it. I want to change or insert a second condition where it has to also look at another value and then insert a blank row




Set cell = Range("O17")
Do Until IsEmpty(cell.Value)
If VarType(cell.Value2) = vbDouble Then
If cell.Value > 1 Then
cell.Offset(1).EntireRow.Range("A1:Q1").Resize(cell.Value - 1).Insert Shift:=xlShiftDown
cell.EntireRow.Range("A1:Q1").Resize(cell.Value).FillDown
End If

Set cell = cell.Offset(cell.Value)
Else
Set cell = cell.Offset(1)
End If
Loop

Rgds

Dries

 

[evnoort]

Hi Dries,

add an other if with an action

Set cell = Range("O17")
    Do Until IsEmpty(cell.Value)
        If VarType(cell.Value2) = vbDouble Then
            If cell.Value > 1 Then
                cell.Offset(1).EntireRow.Range("A1:Q1").Resize(cell.Value - 1).Insert Shift:=xlShiftDown
                cell.EntireRow.Range("A1:Q1").Resize(cell.Value).FillDown
            End If
If cell.Value = "an other value" Then
                      ActiveCell.EntireRow.Insert
             End If

 
            Set cell = cell.Offset(cell.Value)
        Else
            Set cell = cell.Offset(1)
        End If
        Loop

 

[Andries]

Thank you I will try it out and come back if I get stuck

Rgrds

Dries