script runs but doesn't delete

[Janis]

I copied this from the scripting guy website. It runs but doesn't delete the
rows. Since it creates an object it does take a long time to run. I would
actually like it to run from the active worksheet instead of opening the
worksheet as an object but I don't know how to change it. I would settle for
getting this one to delete all the rows in A1 that have Sacramento for a
value.

tia,

------------code--------------

Dim objWorkbook As Object
Dim i As Integer
Dim objRange As Object
Dim objExcel As Object
Const OUTOFAREA As String = "Sacramento"



Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("C:\Temp\Segmentation\07-0707 HSI
Capacity Report.xls")

i = 1

Do Until objExcel.Cells(i, 1).Value = ""
If objExcel.Cells(i, 1).Value = OUTOFAREA Then
Set objRange = objExcel.Cells(i, 1).EntireRow.objRange.Delete
End If
i = i + 1
Loop

End Sub

 

[Vergel Adriano]

Janis,

This will delete all rows that have "Sacramento" in column A.


Sub test()
Dim c As Range
Dim rDelete As Range

For Each c In Application.Intersect(ActiveSheet.UsedRange,
ActiveSheet.Range("A:A"))
If c.Value = "Sacramento" Then
If rDelete Is Nothing Then
Set rDelete = c
Else
Set rDelete = Application.Union(rDelete, c)
End If
End If
Next c

If Not rDelete Is Nothing Then
rDelete.EntireRow.Delete
End If

End Sub

 

[Jim Thomlinson]

Give this a whirl...

Sub DeleteStuff()
Dim rngToSearch As Range
Dim rngFound As Range
Dim rngToDelete As Range
Dim strFirst As String

Set rngToSearch = ActiveSheet.Columns("A")
Set rngFound = rngToSearch.Find(What:="Sacramento", _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
MatchCase:=False)
If rngFound Is Nothing Then
MsgBox "sorry, Nothing to delete"
Else
Set rngToDelete = rngFound
strFirst = rngFound.Address
Do
Set rngToDelete = Union(rngFound, rngToDelete)
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirst
rngToDelete.EntireRow.Delete
End If
End Sub

 

[Janis]

Hey Jim thanks, it was a very long week

Give this a whirl...

Sub DeleteStuff()
Dim rngToSearch As Range
Dim rngFound As Range
Dim rngToDelete As Range
Dim strFirst As String

Set rngToSearch = ActiveSheet.Columns("A")
Set rngFound = rngToSearch.Find(What:="Sacramento", _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
MatchCase:=False)
If rngFound Is Nothing Then
MsgBox "sorry, Nothing to delete"
Else
Set rngToDelete = rngFound
strFirst = rngFound.Address
Do
Set rngToDelete = Union(rngFound, rngToDelete)
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirst
rngToDelete.EntireRow.Delete
End If
End Sub

 

[Janis]

thanks,

Janis,

This will delete all rows that have "Sacramento" in column A.


Sub test()
Dim c As Range
Dim rDelete As Range

For Each c In Application.Intersect(ActiveSheet.UsedRange,
ActiveSheet.Range("A:A"))
If c.Value = "Sacramento" Then
If rDelete Is Nothing Then
Set rDelete = c
Else
Set rDelete = Application.Union(rDelete, c)
End If
End If
Next c

If Not rDelete Is Nothing Then
rDelete.EntireRow.Delete
End If

End Sub