View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Matt P.[_3_] Matt P.[_3_] is offline
external usenet poster
 
Posts: 4
Default Removing rows based on isDate

Ok, I had posted questions on how to do all of this a couple of days ago, and
my post has gotten lost in the mix. With some help, and playing around, I
have acheived my goal of converting 1st set of data below to the 2nd set of
data.
What I want to do now is to remove the rows in which a date "isDate" resides
in a cell in column A. Any help or clean up on what I have would be greatly
appreciated.

Thanks,

Matt


1st
A B
---------------
Fri Oct 19
data
data
data
..
..
..
Thu Oct 18
data
data
data
..
..
..




2nd
A B
-------------------
10/19/2007
data 10/19/2007
data 10/19/2007
data 10/19/2007
data 10/19/2007
..
..
..
10/18/2007
data 10/18/2007
data 10/18/2007
data 10/18/2007
data 10/18/2007
data 10/18/2007
..
..
..




Sub rm_blnk_lns()
' #####################
' This part removes all blank rows
' #####################
Dim Row As Long

Application.ScreenUpdating = False
With ActiveSheet
For Row = .UsedRange.Row + .UsedRange.Rows.Count - 1 To .UsedRange.Row
Step -1
If Application.CountA(.Rows(Row)) = 0 Then .Rows(Row).Delete
Next Row
End With
Application.ScreenUpdating = True

' ###############################################
' This part goes and changes all of the dates from the format Mon Oct 18 to
just Oct 18
' ###############################################

Range("A:A").Select
Cells.Replace What:="Mon ", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False

Range("A:A").Select
Cells.Replace What:="Tue ", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False

Range("A:A").Select
Cells.Replace What:="Wed ", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False

Range("A:A").Select
Cells.Replace What:="Thu ", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False

Range("A:A").Select
Cells.Replace What:="Fri ", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False

Range("A:A").Select
Cells.Replace What:="Sat ", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False

Range("A:A").Select
Cells.Replace What:="Sun ", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False

' ################################################
' This part actually formats the date from Oct 18 to 10/18/2007
' ################################################
Dim D As Date
For Each c In Range("A:A")
If IsDate(c) Then
c.NumberFormat = "m/d/yyyy;@"
c.Offset(1, 1).Value = c.Value
D = c.Value
' .Rows(c).Delete
Else
If c.Value = "" Then
' do nothing
Else
c.Offset(0, 1).Value = D
End If
End If
Next

'################################################# ##
' This part removes all of the hyperlinks from the data
'################################################# ##

Range("A:B").Select
Selection.Hyperlinks.Delete

' ##################################################
' This part autofits columns A & B and removes all borders
' ##################################################

Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit

Range("A:B").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Font.Bold = False

Columns("A:B").Select
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Application.ScreenUpdating = False
End Sub