ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Comparing two dates in one column (https://www.excelbanter.com/excel-programming/377039-comparing-two-dates-one-column.html)

Koveras

Comparing two dates in one column
 
I found this piece of code while searching for a way to underline
anytime there is a date change in column A, but it doesnt always
underline correctly and if ran twice it incorrectly underlines rows.
Where is the bug? I can't find it. Any help is appreciated. thanks!

Dim RowNdx As Long
Dim ColNum As Integer

ColNum = Selection(1).Column
Columns("A:A").Select
Application.ScreenUpdating = False

For RowNdx = Selection(Selection.Cells.Count).Row To _
Selection(1).Row + 1 Step -1
If Cells(RowNdx, ColNum).Value < Cells(RowNdx - 1, ColNum).Value
Then
Cells(RowNdx - 1, 1).EntireRow.Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End If
Next RowNdx


Bob Phillips

Comparing two dates in one column
 
Try this

Dim RowNdx As Long
Dim ColNum As Long
Dim cell As Range

ColNum = Selection(1).Column
Columns("A:A").Select
Application.ScreenUpdating = False

For RowNdx = Selection(Selection.Cells.Count).Row To _
Selection(1).Row + 1 Step -1
If Cells(RowNdx, ColNum).Value < Cells(RowNdx - 1, ColNum).Value
Then
With Cells(RowNdx - 1, 1).EntireRow
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End With
End If
Next RowNdx


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Koveras" wrote in message
ups.com...
I found this piece of code while searching for a way to underline
anytime there is a date change in column A, but it doesnt always
underline correctly and if ran twice it incorrectly underlines rows.
Where is the bug? I can't find it. Any help is appreciated. thanks!

Dim RowNdx As Long
Dim ColNum As Integer

ColNum = Selection(1).Column
Columns("A:A").Select
Application.ScreenUpdating = False

For RowNdx = Selection(Selection.Cells.Count).Row To _
Selection(1).Row + 1 Step -1
If Cells(RowNdx, ColNum).Value < Cells(RowNdx - 1, ColNum).Value
Then
Cells(RowNdx - 1, 1).EntireRow.Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End If
Next RowNdx




Jay

Comparing two dates in one column
 
Hi Koveras -

Although the procedure has some unnecessary steps, it seems to work OK when
I test it. Can you describe your symptoms in more detail?
--
Jay


"Koveras" wrote:

I found this piece of code while searching for a way to underline
anytime there is a date change in column A, but it doesnt always
underline correctly and if ran twice it incorrectly underlines rows.
Where is the bug? I can't find it. Any help is appreciated. thanks!

Dim RowNdx As Long
Dim ColNum As Integer

ColNum = Selection(1).Column
Columns("A:A").Select
Application.ScreenUpdating = False

For RowNdx = Selection(Selection.Cells.Count).Row To _
Selection(1).Row + 1 Step -1
If Cells(RowNdx, ColNum).Value < Cells(RowNdx - 1, ColNum).Value
Then
Cells(RowNdx - 1, 1).EntireRow.Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End If
Next RowNdx



Koveras

Comparing two dates in one column
 
It works now. I moved Column("A:A").Select above ColNum =
Selection(1).Column and its no longer underlining randomly. Thanks for
the help.


Jay wrote:
Hi Koveras -

Although the procedure has some unnecessary steps, it seems to work OK when
I test it. Can you describe your symptoms in more detail?
--
Jay


"Koveras" wrote:

I found this piece of code while searching for a way to underline
anytime there is a date change in column A, but it doesnt always
underline correctly and if ran twice it incorrectly underlines rows.
Where is the bug? I can't find it. Any help is appreciated. thanks!

Dim RowNdx As Long
Dim ColNum As Integer

ColNum = Selection(1).Column
Columns("A:A").Select
Application.ScreenUpdating = False

For RowNdx = Selection(Selection.Cells.Count).Row To _
Selection(1).Row + 1 Step -1
If Cells(RowNdx, ColNum).Value < Cells(RowNdx - 1, ColNum).Value
Then
Cells(RowNdx - 1, 1).EntireRow.Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End If
Next RowNdx





All times are GMT +1. The time now is 03:08 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com