Insert blank row problem Excel 2000

[grego9]

I am trying to write some code to get Excel 2000 to insert a blank row wherever there is a "NO" in column O (above the NO). The code below nearly does this - but not quite!. The problem I have is that if there are 2 or 3 consecutive NO's in column O then this code inserts 2 or 3 rows above the first "NO" and doesn't insert a row inbetween each "NO"

NB the data range will change - so I will have to use some sort of search function to locate where the NO's are in the range.


any ideas on how to get excel to insert a row above each "NO"?

thanks


Dim MyRangenew As Range, DelRangenew As Range, Fnew As Range
Dim MatchStringnew As String, SearchColumnnew As String, ActiveColumnnew As String
Dim FirstAddressnew As String, NullChecknew As String
Dim AFnew

Set MyRangenew = Columns("O")

Set Fnew = MyRangenew.Find(What:="NO", after:=MyRangenew.Cells(1), LookIn:=xlValues, Lookat:=xlPart)
If Not Fnew Is Nothing Then
Set DelRangenew = Fnew
FirstAddressnew = Fnew.Address
Do
Set Fnew = MyRangenew.FindNext(Fnew)
Set DelRangenew = Union(DelRangenew, Fnew)
Loop While FirstAddressnew <> Fnew.Address
End If

'If there are valid matches then delete the rows
If Not DelRangenew Is Nothing Then DelRangenew.EntireRow.Insert Shift:=xlDown

Application.ScreenUpdating = True

[QVeen72]

Hi,

This works fine here :

Dim MyRangenew As Range, DelRangenew As Range, Fnew As Range
Dim MatchStringnew As String, SearchColumnnew As String, ActiveColumnnew As String
Dim FirstAddressnew As String, NullChecknew As String
Dim K
Dim T
Set MyRangenew = Columns("O")
K = 1
Set Fnew = MyRangenew.Find(What:="NO", after:=MyRangenew.Cells(K), LookIn:=xlValues, Lookat:=xlPart)
If Not Fnew Is Nothing Then T = Fnew.Row
Do
   Set Fnew = MyRangenew.Find(What:="NO", after:=MyRangenew.Cells(K), LookIn:=xlValues, Lookat:=xlPart)
   If Not Fnew Is Nothing Then
      Set DelRangenew = Fnew
      K = Fnew.Row + 1
      If K = (T + 2) Then Exit Do
      If Not DelRangenew Is Nothing Then
         DelRangenew.EntireRow.Insert Shift:=xlDown
      End If
   Else
     Exit Do
   End If
Loop Until K <= T
 
Application.ScreenUpdating = True
 

REgards
Veena

[grego9]

Veena - thanks for the help - When I type this code in I get the following message " Compile Error Else Without IF" and the Else word is highlighted

any ideas?

thanks again

Hi,

This works fine here :

Dim MyRangenew As Range, DelRangenew As Range, Fnew As Range
Dim MatchStringnew As String, SearchColumnnew As String, ActiveColumnnew As String
Dim FirstAddressnew As String, NullChecknew As String
Dim K
Dim T
Set MyRangenew = Columns("O")
K = 1
Set Fnew = MyRangenew.Find(What:="NO", after:=MyRangenew.Cells(K), LookIn:=xlValues, Lookat:=xlPart)
If Not Fnew Is Nothing Then T = Fnew.Row
Do
   Set Fnew = MyRangenew.Find(What:="NO", after:=MyRangenew.Cells(K), LookIn:=xlValues, Lookat:=xlPart)
   If Not Fnew Is Nothing Then
      Set DelRangenew = Fnew
      K = Fnew.Row + 1
      If K = (T + 2) Then Exit Do
      If Not DelRangenew Is Nothing Then
         DelRangenew.EntireRow.Insert Shift:=xlDown
      End If
   Else
     Exit Do
   End If
Loop Until K <= T
 
Application.ScreenUpdating = True
 

REgards
Veena

[QVeen72]

Hi,

That Code works fine here.. Can u post ur Code here after modification..? MAy be while doing Copy /Paste, Some things might have missed....

Regards
Veena

[grego9]

Veena - here is the code - I've scanned through it and can't find any differences - apologies if I have missed something!

thanks for your help

Dim MyRangenew As Range, DelRangenew As Range, Fnew As Range
Dim MatchStringnew As String, SearchColumnnew As String, ActiveColumnnew As String
Dim FirstAddressnew As String, NullChecknew As String
Dim K
Dim T



Set MyRangenew = Columns("O")
K = 1

Set Fnew = MyRangenew.Find(What:="NO", after:=MyRangenew.Cells(K), LookIn:=xlValues, Lookat:=xlPart)
If Not Fnew Is Nothing Then T = Fnew.Row
Do
Set Fnew = MyRangenew.Find(What:="NO", after:=MyRangenew.Cells(K), LookIn:=xlValues, Lookat:=xlPart)
If Not Fnew Is Nothing Then
Set DelRangenew = Fnew
K = Fnew.Row + 1
If K = (T + 2) Then Exit Do
If Not DelRangenew Is Nothing Then DelRangenew.EntireRow.Insert Shift:=xlDown
End If
Else
Exit Do
End If
Loop Until K <= T

Application.ScreenUpdating = True

Hi,

That Code works fine here.. Can u post ur Code here after modification..? MAy be while doing Copy /Paste, Some things might have missed....

Regards
Veena

[QVeen72]

Hi,

Line Breaks here :

        If Not DelRangenew Is Nothing Then 
              DelRangenew.EntireRow.Insert Shift:=xlDown
        End If
 

Posting the Entire Code Again for ur Reference (with proper Indentation):

Dim MyRangenew As Range, DelRangenew As Range, Fnew As Range
Dim MatchStringnew As String, SearchColumnnew As String, ActiveColumnnew As String
Dim FirstAddressnew As String, NullChecknew As String
Dim K
Dim T
Set MyRangenew = Columns("A")
K = 1
Set Fnew = MyRangenew.Find(What:="NO", after:=MyRangenew.Cells(K), LookIn:=xlValues, Lookat:=xlPart)
If Not Fnew Is Nothing Then T = Fnew.Row
Do
    Set Fnew = MyRangenew.Find(What:="NO", after:=MyRangenew.Cells(K), LookIn:=xlValues, Lookat:=xlPart)
    If Not Fnew Is Nothing Then
        Set DelRangenew = Fnew
        K = Fnew.Row + 1
        If K = (T + 2) Then Exit Do
        If Not DelRangenew Is Nothing Then
             DelRangenew.EntireRow.Insert Shift:=xlDown
        End If
    Else
        Exit Do
    End If
Loop Until K <= T
Application.ScreenUpdating = True
 

Regards
Veena

[grego9]

Thanks Veena - it worked perfectly - I've spent hours on this and was losing the will to live - so thank you very much for your help