For Each statement

  • Thread starter Thread starter jacqui
  • Start date Start date
J

jacqui

Can anyone kindly recommend the quickest way to insert
rows based on specific criteria. For example I have VBA
that inserts a row when the loop finds that a cell in the
range is formatted to Bold but is not Italic. I do this
with the following
Sub format_InsertRows()

Dim lngLastRow As Long
Dim i As Long

With Worksheets("data")
lngLastRow = .Cells(Rows.Count, 6).End(xlUp).Row

For i = lngLastRow To 2 Step -1
If .Cells(i, 6).Font.Bold And _
Not .Cells(i, 6).Font.Italic Then
.Cells(i + 1, 6).EntireRow.Insert
End If
Next

End With
End Sub


Now I need to be more specific and say if the contents of
cells i, 7 = string value "Other" then insert 3 rows above
it and if cells i, 7 = "Belfast" then insert 4 rows above
it. I also need to say if cells i, 7 = "Disc" then delete
3 rows beneath it. Given that the datafile contains about
3000 rows in i, I wondered if it might be quicker to do an
Edit/Find or a Do Until thing. Can anyone suggest the
quickest way and provide the syntax to do the above. My
methods may seem a bit crazy but I need to make the
datafile the same shape as a template to copy/paste the
data into. NB: Making my source data the same shape as
the template is not an option, Excel needs to do the work
unfortunately.
Many thanks
Jacqui
 
This might help. Have a look in VBA help for resize
If Cells(i, 1) = "Other" Then Cells(i, 1).Resize(3, 1).EntireRow.Insert
If Cells(i, 1) = "Belfast" Then Cells(i, 1).Resize(4, 1).EntireRow.Insert
 
See the excel VBA help on the findnext method. The sample code shows you
how to do this for values in a cell. If you want to check formatting only,
then you need to loop in xl2000 and earlier (at least)
 
VBA Help says that Resize syntax applies to Chart objects
only. As I'm an Office '97 user is this maybe something
that became available in Excel 2000 upwards?
Can you help any further.
Many thanks
Jacqui
 
Tom

Thanks for your reply. I've had a look at the FindNext
method in VBA and whilst understanding the demo with the
find value of 2, I'm struggling re-write for my example.
Can you kindly help? I'm not testing for any formatting,
just string values of "Other", "Belfast" and "Disc" in
cells i, 7. I'm not sure how to insert more than one row
at a time either. I'm used to coding EntireRow.Insert but
how do I ask VBA to insert 3 rows for "Other", 4 rows
for "Belfast" yet delete a row if it's "Disc". Sorry
but can't get my head around this one.

Many thanks
Jacqui
 
With Worksheets(1).Range("a1:a500") Set c = .Find(2, lookin:=xlValues)
If Not c Is Nothing Then firstAddress = c.Address Do
c.Interior.Pattern = xlPatternGray50 Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress End IfEnd
WithbecomesSub Tester2()With ActiveSheet.Range("G:G")Set c = .Find("Other",
LookIn:=xlValues, MatchCase:=False) If Not c Is Nothing Then firstrow =
c.Row i = 0 Do i = i + 1 c.Resize(3).EntireRow.Insert If i = 1 Then
firstrow = firstrow + 3 Set c = .FindNext(c) Loop While c.Row <> firstrow
End If Set c = .Find("Belfast", LookIn:=xlValues, MatchCase:=False) If Not c
Is Nothing Then firstrow = c.Row i = 0 Do i = i + 1
c.Resize(4).EntireRow.Insert If i = 1 Then firstrow = firstrow + 4 Set c
= .FindNext(c) Loop While c.Row <> firstrow End If Set c = .Find("Disc",
LookIn:=xlValues, MatchCase:=False) If Not c Is Nothing Then firstrow =
c.Row Do c.Offset(1, 0).Resize(3).EntireRow.Delete Set c = .FindNext(c)
Loop While c.Row <> firstrow End IfEnd WithEnd Sub-- Regards,Tom
 
Thank You Tom. Much appreciated.
Jacqui
-----Original Message-----
With Worksheets(1).Range("a1:a500") Set c = .Find(2, lookin:=xlValues)
If Not c Is Nothing Then firstAddress = c.Address Do
c.Interior.Pattern = xlPatternGray50 Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress End IfEnd
WithbecomesSub Tester2()With ActiveSheet.Range("G:G")Set c = .Find("Other",
LookIn:=xlValues, MatchCase:=False) If Not c Is Nothing Then firstrow =
c.Row i = 0 Do i = i + 1 c.Resize
Click to expand...
(3).EntireRow.Insert If i = 1 Then
 
That appears to have gotten jumbled up - here is a repost:

Sub Tester2()
With ActiveSheet.Range("G:G")
Set c = .Find("Other", LookIn:=xlValues, MatchCase:=False)
If Not c Is Nothing Then
firstrow = c.Row
i = 0
Do
i = i + 1
c.Resize(3).EntireRow.Insert
If i = 1 Then firstrow = firstrow + 3
Set c = .FindNext(c)
Loop While c.Row <> firstrow
End If

Set c = .Find("Belfast", LookIn:=xlValues, MatchCase:=False)
If Not c Is Nothing Then
firstrow = c.Row
i = 0
Do
i = i + 1
c.Resize(4).EntireRow.Insert
If i = 1 Then firstrow = firstrow + 4
Set c = .FindNext(c)
Loop While c.Row <> firstrow
End If

Set c = .Find("Disc", LookIn:=xlValues, MatchCase:=False)
If Not c Is Nothing Then
firstrow = c.Row
Do
c.Offset(1, 0).Resize(3).EntireRow.Delete
Set c = .FindNext(c)
Loop While c.Row <> firstrow
End If
End With
End Sub
 
Back
Top