By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
431,852 Members | 2,152 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 431,852 IT Pros & Developers. It's quick & easy.

Insert blank row problem Excel 2000

P: 63
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
Sep 3 '07 #1
Share this Question
Share on Google+
6 Replies


QVeen72
Expert 100+
P: 1,445
Hi,

This works fine here :

Expand|Select|Wrap|Line Numbers
  1. Dim MyRangenew As Range, DelRangenew As Range, Fnew As Range
  2. Dim MatchStringnew As String, SearchColumnnew As String, ActiveColumnnew As String
  3. Dim FirstAddressnew As String, NullChecknew As String
  4. Dim K
  5. Dim T
  6. Set MyRangenew = Columns("O")
  7. K = 1
  8. Set Fnew = MyRangenew.Find(What:="NO", after:=MyRangenew.Cells(K), LookIn:=xlValues, Lookat:=xlPart)
  9. If Not Fnew Is Nothing Then T = Fnew.Row
  10. Do
  11.    Set Fnew = MyRangenew.Find(What:="NO", after:=MyRangenew.Cells(K), LookIn:=xlValues, Lookat:=xlPart)
  12.    If Not Fnew Is Nothing Then
  13.       Set DelRangenew = Fnew
  14.       K = Fnew.Row + 1
  15.       If K = (T + 2) Then Exit Do
  16.       If Not DelRangenew Is Nothing Then
  17.          DelRangenew.EntireRow.Insert Shift:=xlDown
  18.       End If
  19.    Else
  20.      Exit Do
  21.    End If
  22. Loop Until K <= T
  23.  
  24. Application.ScreenUpdating = True
  25.  
REgards
Veena
Sep 3 '07 #2

P: 63
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 :

Expand|Select|Wrap|Line Numbers
  1. Dim MyRangenew As Range, DelRangenew As Range, Fnew As Range
  2. Dim MatchStringnew As String, SearchColumnnew As String, ActiveColumnnew As String
  3. Dim FirstAddressnew As String, NullChecknew As String
  4. Dim K
  5. Dim T
  6. Set MyRangenew = Columns("O")
  7. K = 1
  8. Set Fnew = MyRangenew.Find(What:="NO", after:=MyRangenew.Cells(K), LookIn:=xlValues, Lookat:=xlPart)
  9. If Not Fnew Is Nothing Then T = Fnew.Row
  10. Do
  11.    Set Fnew = MyRangenew.Find(What:="NO", after:=MyRangenew.Cells(K), LookIn:=xlValues, Lookat:=xlPart)
  12.    If Not Fnew Is Nothing Then
  13.       Set DelRangenew = Fnew
  14.       K = Fnew.Row + 1
  15.       If K = (T + 2) Then Exit Do
  16.       If Not DelRangenew Is Nothing Then
  17.          DelRangenew.EntireRow.Insert Shift:=xlDown
  18.       End If
  19.    Else
  20.      Exit Do
  21.    End If
  22. Loop Until K <= T
  23.  
  24. Application.ScreenUpdating = True
  25.  
REgards
Veena
Sep 4 '07 #3

QVeen72
Expert 100+
P: 1,445
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
Sep 4 '07 #4

P: 63
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
Sep 4 '07 #5

QVeen72
Expert 100+
P: 1,445
Hi,

Line Breaks here :

Expand|Select|Wrap|Line Numbers
  1.         If Not DelRangenew Is Nothing Then 
  2.               DelRangenew.EntireRow.Insert Shift:=xlDown
  3.         End If
  4.  
Posting the Entire Code Again for ur Reference (with proper Indentation):

Expand|Select|Wrap|Line Numbers
  1. Dim MyRangenew As Range, DelRangenew As Range, Fnew As Range
  2. Dim MatchStringnew As String, SearchColumnnew As String, ActiveColumnnew As String
  3. Dim FirstAddressnew As String, NullChecknew As String
  4. Dim K
  5. Dim T
  6. Set MyRangenew = Columns("A")
  7. K = 1
  8. Set Fnew = MyRangenew.Find(What:="NO", after:=MyRangenew.Cells(K), LookIn:=xlValues, Lookat:=xlPart)
  9. If Not Fnew Is Nothing Then T = Fnew.Row
  10. Do
  11.     Set Fnew = MyRangenew.Find(What:="NO", after:=MyRangenew.Cells(K), LookIn:=xlValues, Lookat:=xlPart)
  12.     If Not Fnew Is Nothing Then
  13.         Set DelRangenew = Fnew
  14.         K = Fnew.Row + 1
  15.         If K = (T + 2) Then Exit Do
  16.         If Not DelRangenew Is Nothing Then
  17.              DelRangenew.EntireRow.Insert Shift:=xlDown
  18.         End If
  19.     Else
  20.         Exit Do
  21.     End If
  22. Loop Until K <= T
  23. Application.ScreenUpdating = True
  24.  

Regards
Veena
Sep 4 '07 #6

P: 63
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
Sep 4 '07 #7

Post your reply

Sign in to post your reply or Sign up for a free account.