johnbird1988
Board Regular
- Joined
- Oct 6, 2009
- Messages
- 199
Hello </PRE>
I have found these example on the internet to delete row if a specific value exist. They both work fine but I need</PRE>
it to find the specific value ("John") in examples below and select that entire row + the next 7 rows below it.</PRE>
Is these a way this can be done with the examples below either one of the examples will be fine to work with.</PRE>
Thanks</PRE>
John</PRE>
Example 1</PRE>
Sub Union_Example() Dim Firstrow As Long Dim Lastrow As Long Dim Lrow As Long Dim CalcMode As Long Dim ViewMode As Long Dim rng As Range With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False End With With ActiveSheet ViewMode = ActiveWindow.View ActiveWindow.View = xlNormalView Firstrow = .UsedRange.Cells(1).Row Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row For Lrow = Lastrow To Firstrow Step -1 With .Cells(Lrow, "A") If Not IsError(.Value) Then If .Value = "ron" Then If rng Is Nothing Then Set rng = .Cells Else Set rng = Application.Union(rng, .Cells) End If End If End If End With Next Lrow End With</PRE>
If Not rng Is Nothing Then rng.EntireRow.Delete ActiveWindow.View = ViewMode With Application .ScreenUpdating = True .Calculation = CalcMode End WithEnd Sub</PRE>
Example 2
Sub Find_Example() Dim calcmode As Long Dim ViewMode As Long Dim myStrings As Variant Dim FoundCell As Range Dim I As Long Dim myRng As Range Dim sh As Worksheet With Application calcmode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False End With Set sh = ActiveSheet Set myRng = sh.Range("A:A") myStrings = Array("John") With sh .Select ViewMode = ActiveWindow.View ActiveWindow.View = xlNormalView .DisplayPageBreaks = False With myRng For I = LBound(myStrings) To UBound(myStrings) Do Set FoundCell = myRng.Find(What:=myStrings(I), _ After:=.Cells(.Cells.Count), _ LookIn:=xlFormulas, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If FoundCell Is Nothing Then Exit Do Else FoundCell.EntireRow.Delete End If Loop Next I End With End With ActiveWindow.View = ViewMode With Application .ScreenUpdating = True .Calculation = calcmode End WithEnd Sub</PRE>
I have found these example on the internet to delete row if a specific value exist. They both work fine but I need</PRE>
it to find the specific value ("John") in examples below and select that entire row + the next 7 rows below it.</PRE>
Is these a way this can be done with the examples below either one of the examples will be fine to work with.</PRE>
Thanks</PRE>
John</PRE>
Example 1</PRE>
Sub Union_Example() Dim Firstrow As Long Dim Lastrow As Long Dim Lrow As Long Dim CalcMode As Long Dim ViewMode As Long Dim rng As Range With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False End With With ActiveSheet ViewMode = ActiveWindow.View ActiveWindow.View = xlNormalView Firstrow = .UsedRange.Cells(1).Row Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row For Lrow = Lastrow To Firstrow Step -1 With .Cells(Lrow, "A") If Not IsError(.Value) Then If .Value = "ron" Then If rng Is Nothing Then Set rng = .Cells Else Set rng = Application.Union(rng, .Cells) End If End If End If End With Next Lrow End With</PRE>
If Not rng Is Nothing Then rng.EntireRow.Delete ActiveWindow.View = ViewMode With Application .ScreenUpdating = True .Calculation = CalcMode End WithEnd Sub</PRE>
Example 2
Sub Find_Example() Dim calcmode As Long Dim ViewMode As Long Dim myStrings As Variant Dim FoundCell As Range Dim I As Long Dim myRng As Range Dim sh As Worksheet With Application calcmode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False End With Set sh = ActiveSheet Set myRng = sh.Range("A:A") myStrings = Array("John") With sh .Select ViewMode = ActiveWindow.View ActiveWindow.View = xlNormalView .DisplayPageBreaks = False With myRng For I = LBound(myStrings) To UBound(myStrings) Do Set FoundCell = myRng.Find(What:=myStrings(I), _ After:=.Cells(.Cells.Count), _ LookIn:=xlFormulas, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If FoundCell Is Nothing Then Exit Do Else FoundCell.EntireRow.Delete End If Loop Next I End With End With ActiveWindow.View = ViewMode With Application .ScreenUpdating = True .Calculation = calcmode End WithEnd Sub</PRE>