Solved: Delete Rows

[WillyInAUs]

Hi Peoples
I am very new to VBA I think it can be done but I am unsure how to start.
what I have is a 10 reports that I get on a daily bases that has over 60-100pages x 55 rows of data in nine columns that I can import into excel.

when I do this I end up with a whole lot of garbage at the top of each page that needs to be deleted after the import :banghead: the last person was doing this by hand, now I know why they left!

What I need to do is if column C has any Date in it say 13/09/2006 keep that row, if not Delete the row and keep moving down the sheet until it reaches the end, That will get rid of all the garbage on each sheet I hope, its a waste of time doing it by hand and I have just taken over this role today.

I have to then find some way to tally all the results for each operator as well i the long run, but if I can get this worked out then I will be heading down the right way to start.


Thx In advance
Willy

[ALe]

this should work

Sub DeleteEmptyRows()
' delete all rows of each sheet if Column(C) value is not a date
Dim wk As Worksheet
Dim MyArea As Range
Dim i As Long
For Each wk In ThisWorkbook.Worksheets
Set MyArea = Application.Intersect(wk.UsedRange, wk.Columns(3))
For i = MyArea.Cells.Count To 1 Step -1
If IsDate(MyArea.Cells(i).Value) = False Then MyArea.Cells(i).EntireRow.Delete
Next i
Next wk
End Sub

[WillyInAUs]

HI Ale your a legend,

Thankyou so much it works a treat I can now go to bed and sleep well.
I have now gone from :banghead: to :cloud9: in less then an hour.

THAnkyou Once again!
Willy

[WillyInAUs]

To think the lady that was doing this took half the day to what you have allowed me to do in about 5mins.


THX

[ALe]

ok.
please mark threads as solved when a solution is reached

[mdmackillop]

Hi Willy,
5 minutes seems a long time to wait. Preventing the sceeen from updating should speed things up a bit.


Sub DeleteEmptyRows()
' delete all rows of each sheet if Column(C) value is not a date
Dim wk As Worksheet
Dim MyArea As Range
Dim i As Long
Application.ScreenUpdating = False
For Each wk In ThisWorkbook.Worksheets
Set MyArea = Application.Intersect(wk.UsedRange, wk.Columns(3))
For i = MyArea.Cells.Count To 1 Step -1
If IsDate(MyArea.Cells(i).Value) = False Then MyArea.Cells(i).EntireRow.Delete
Next i
Next wk
Application.ScreenUpdating = True
End Sub

[WillyInAUs]

Hi,
Hey yep thats works even better.
Thx for your help

[malik641]

5 minutes?

Give me till tonight. I made something for someone else that reduced their delete row method from 12 minutes to 1 minute 30 seconds. I'd like for you to take a look :) I think it will help a good amount.

BTW, it will soon be a KB entry :cool:

[malik641]

Oh yes, and Welcome to VBAX!

[mdmackillop]

Can't wait Joseph!:runaway:

[malik641]

:giggle sorry if the other post seemed odd...I was hyped up on caffeine.....

Anyway this will do it...mostly. What it does is store all the rows to delete into a string and execute the Delete method just one time...much less time-consuming :)

There's just one problem with it. If the string value of the strRowDel is greater than 255....an error will occur.

I have to go to my other job now, so I would like to try to fix this error later (unless someone can come up with something first :yes). But for now, check this out:

EDIT: I forgot to clear the strRowDel before the next worksheet. It is fixed now, though.
Sub DeleteEmptyRows()
' delete all rows of each sheet if Column(C) value is not a date
Dim wk As Worksheet
Dim MyArea As Range

Dim varTestValues As Variant
Dim Start As Double, Finish As Double
Dim lRowNum As Long
Dim lRowStart As Long, lRowEnd As Long, LastGoodRow As Long
Dim strRowDel As String
Start = Timer

Application.ScreenUpdating = False
For Each wk In ThisWorkbook.Worksheets
Set MyArea = Application.Intersect(wk.UsedRange, wk.Columns(3))

For lRowNum = MyArea.Cells.Count To 1 Step -1
If IsDate(MyArea.Cells(lRowNum).Value) = False Then
If lRowStart = 0 Then
lRowStart = lRowNum
lRowEnd = lRowNum
End If

If ((lRowEnd) - lRowNum) <= 1 Then
lRowEnd = lRowNum
Else
strRowDel = strRowDel & lRowStart & ":" & lRowEnd & ","
lRowStart = lRowNum
lRowEnd = lRowNum
LastGoodRow = 0
End If
Else
If LastGoodRow = 0 Then LastGoodRow = lRowNum

If lRowNum = 1 Then
lRowEnd = LastGoodRow + 1
strRowDel = strRowDel & lRowStart & ":" & lRowEnd & ","
lRowStart = lRowNum
lRowEnd = lRowNum
End If
End If
Next

varTestValues = Split(strRowDel, ",")
varTestValues = Split(UBound(varTestValues), ":")

If UBound(varTestValues) = (lRowEnd) Then strRowDel = strRowDel & lRowStart & ":" & lRowEnd & ","

strRowDel = Left(strRowDel, Len(strRowDel) - 1)

wk.Range(strRowDel).EntireRow.Delete xlUp
Debug.Print strRowDel
strRowDel = ""
Next wk
Application.ScreenUpdating = True

Finish = Timer
MsgBox (Finish - Start)
End Sub

[mdmackillop]

Hi Joseph,
You could start by deleting all rows where Column C is blank

Columns(3).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

[malik641]

Good idea, thanks Malcom :thumb