Macro to Recognize Dates

Hello.

I am attempting to write a Macro to automate some formatting I do as a
result of an ugly cut and paste into excel from Adobe Acrobat. I have the
manual process down and now I am having trouble automating it. I want the
macro to search column A for the words Print, Users, Status and Page; and any
dates. I then want the macro to delete the entire row. So far I have it
finding and deleting the text okay with a "Case" function. For some reason it
is not finding the dates.

Any ideas?
--
Joe S

Hi,

You say you are looking for any word Print, Users, Status and Page, and any
dates; i guess you are looping through the entire column cell by cell.

In code how are you checking whether or not the data is a date?
A few ways:

Dim cell as Range, d as Date

Debug.Print typename(cell.value) '----> returns Date?

on error resume next
d=cdate(cell.value)
if err<>0 then 'not a date
msgbox "Not a date"
else 'it's a date
'...
end if

--
Regards,
Sébastien
<http://www.ondemandanalysis.com>


"JoeS" wrote:

> Hello.
>
> I am attempting to write a Macro to automate some formatting I do as a
> result of an ugly cut and paste into excel from Adobe Acrobat. I have the
> manual process down and now I am having trouble automating it. I want the
> macro to search column A for the words Print, Users, Status and Page; and any
> dates. I then want the macro to delete the entire row. So far I have it
> finding and deleting the text okay with a "Case" function. For some reason it
> is not finding the dates.
>
> Any ideas?
> --
> Joe S

My code is as follows:

Do Until ActiveCell = ""
Select Case ActiveCell
Case Is = "Print"
ActiveCell.EntireRow.Delete
End Select
ActiveCell.Offset(1, 0).Select
Loop
Range("A1").Select
Do Until ActiveCell = ""
Select Case ActiveCell
Case Is = "Page"
ActiveCell.EntireRow.Delete
End Select
ActiveCell.Offset(1, 0).Select
Loop
Range("A1").Select
Do Until ActiveCell = ""
Select Case ActiveCell
Case Is = "Users"
ActiveCell.EntireRow.Delete
End Select
ActiveCell.Offset(1, 0).Select
Loop
Range("A1").Select
Do Until ActiveCell = ""
Select Case ActiveCell
Case Is = "Status"
ActiveCell.EntireRow.Delete
End Select
ActiveCell.Offset(1, 0).Select
Loop
Range("A1").Select
Do Until ActiveCell = ""
If ActiveCell.Value > DateValue("01/10/1901") Then
ActiveCell.EntireRow.Delete
End If
ActiveCell.Offset(1, 0).Select
Loop

I entered the searches one at a time because the words are sometimes
directly below each other and this was the only way I could get it to find
all of the text.

Thanks
--
Joe S


"sebastienm" wrote:

> Hi,
>
> You say you are looking for any word Print, Users, Status and Page, and any
> dates; i guess you are looping through the entire column cell by cell.
>
> In code how are you checking whether or not the data is a date?
> A few ways:
>
> Dim cell as Range, d as Date
>
> Debug.Print typename(cell.value) '----> returns Date?
>
> on error resume next
> d=cdate(cell.value)
> if err<>0 then 'not a date
> msgbox "Not a date"
> else 'it's a date
> '...
> end if
>
> --
> Regards,
> Sébastien
> <http://www.ondemandanalysis.com>
>
>
> "JoeS" wrote:
>
> > Hello.
> >
> > I am attempting to write a Macro to automate some formatting I do as a
> > result of an ugly cut and paste into excel from Adobe Acrobat. I have the
> > manual process down and now I am having trouble automating it. I want the
> > macro to search column A for the words Print, Users, Status and Page; and any
> > dates. I then want the macro to delete the entire row. So far I have it
> > finding and deleting the text okay with a "Case" function. For some reason it
> > is not finding the dates.
> >
> > Any ideas?
> > --
> > Joe S

1. Check the online help for the Select Case, you'll see that you can group
muliple case with:
Select Case ActiveCell
Case "Print", "Page", "Users", "Status"
.....
2. Any way, try the follwoing:

Sub test()
Dim rg As Range, rgDelete As Range
Dim TextValues As String
Dim IsToBeDeleted As Boolean, IsInTextValues As Boolean, IsADate As Boolean

Set rg = Range("A1")
TextValues = "Print,Page,Users,Status"


On Error Resume Next ' to prevent error when converting date
TextValues = "," & TextValues & ","

Do Until rg = ""
rg.Select
'check for text values
IsInTextValues = TextValues Like ("*," & rg.Text & ",*")
'check for a date
IsADate = (CDate(rg.Text) > DateValue("01/10/1901"))
If Err <> 0 Then Err.Clear
'Is to be deleted
IsToBeDeleted = IsInTextValues Or IsADate
If IsToBeDeleted Then
If rgDelete Is Nothing Then 'no range in it yet
Set rgDelete = rg
Else 'just add to it
Set rgDelete = Application.Union(rg, rgDelete)
End If
End If
'next cell
IsADate = False
IsInTextValues = False
Set rg = rg.Offset(1, 0)
Loop

'Delete at the end only
If Not rg Is Nothing Then
rg.EntireRow.Delete 'rgDelete.EntireRow.Select
End If
End Sub

I hope this helps
--
Regards,
Sébastien
<http://www.ondemandanalysis.com>

Still not recognizing the dates. The text format doesn't seem to be picking
up the text either.

Is there a way to simply say if activecell is a date in ##/##/#### format,
delete the entire row?

-- Joe S


"sebastienm" wrote:

> 1. Check the online help for the Select Case, you'll see that you can group
> muliple case with:
> Select Case ActiveCell
> Case "Print", "Page", "Users", "Status"
> .....
> 2. Any way, try the follwoing:
>
> Sub test()
> Dim rg As Range, rgDelete As Range
> Dim TextValues As String
> Dim IsToBeDeleted As Boolean, IsInTextValues As Boolean, IsADate As Boolean
>
> Set rg = Range("A1")
> TextValues = "Print,Page,Users,Status"
>
>
> On Error Resume Next ' to prevent error when converting date
> TextValues = "," & TextValues & ","
>
> Do Until rg = ""
> rg.Select
> 'check for text values
> IsInTextValues = TextValues Like ("*," & rg.Text & ",*")
> 'check for a date
> IsADate = (CDate(rg.Text) > DateValue("01/10/1901"))
> If Err <> 0 Then Err.Clear
> 'Is to be deleted
> IsToBeDeleted = IsInTextValues Or IsADate
> If IsToBeDeleted Then
> If rgDelete Is Nothing Then 'no range in it yet
> Set rgDelete = rg
> Else 'just add to it
> Set rgDelete = Application.Union(rg, rgDelete)
> End If
> End If
> 'next cell
> IsADate = False
> IsInTextValues = False
> Set rg = rg.Offset(1, 0)
> Loop
>
> 'Delete at the end only
> If Not rg Is Nothing Then
> rg.EntireRow.Delete 'rgDelete.EntireRow.Select
> End If
> End Sub
>
> I hope this helps
> --
> Regards,
> Sébastien
> <http://www.ondemandanalysis.com>
>
>