Highlighting Cells - based on time difference

[JinkyJulie via OfficeKB.com]

Hi again...

My document has a table (could vary in length (rows)) containing times (eg 2:
34 OR 19:54)... What I would like to do it highlight any two adjacent cells
that have a difference of ten (10) minutes or more...

For example... (row numbers are just for reference)

1 19:00
2 19:03
3 19:05
4 19:17
5 19:19
6 19:22
7 19:37

so cells 3 & 4 and cells 6 & 7 are highlighted...

Once all highlighted... return to top of table (excluding header) and delete
all rows not highlighted....

Too Much?!?!?! Any help or direction would be greatly appreciated... I am
getting nowhere with this requirement...

Best regards,

Julie

 

[Graham Mayor]

Something like:

Dim oTable As Table
Dim orng As Range
Dim iMin As Long
Dim iCol As Integer
Set oTable = ActiveDocument.Tables(1)
iCol = 2 'Column with the times
With oTable
Set orng = .Cell(1, iCol).Range
orng.End = orng.End - 1
sText = orng.Text
For i = 2 To .Rows.Count
Set orng = .Cell(i, iCol).Range
orng.End = orng.End - 1
iMin = Minute(orng.Text) - Minute(sText)
If iMin >= 10 Then
.Rows(i).Shading.BackgroundPatternColor = _
wdColorLightBlue
.Rows(i - 1).Shading.BackgroundPatternColor = _
wdColorLightBlue
End If
sText = orng.Text
Next i
For i = .Rows.Count To 1 Step -1
If .Rows(i).Shading.BackgroundPatternColor _
<> wdColorLightBlue Then
.Rows(i).Delete
End If
Next i
'.Shading.BackgroundPatternColor = wdColorWhite
End With

should do the trick. If the table has a header row you will need to adjust
the start of the range of rows to be searched from 1 to 2 ie

Dim oTable As Table
Dim orng As Range
Dim iMin As Long
Dim iCol As Integer
Set oTable = ActiveDocument.Tables(1)
iCol = 2 'Column with the times
With oTable
Set orng = .Cell(2, iCol).Range
orng.End = orng.End - 1
sText = orng.Text
For i = 3 To .Rows.Count
Set orng = .Cell(i, iCol).Range
orng.End = orng.End - 1
iMin = Minute(orng.Text) - Minute(sText)
If iMin >= 10 Then
.Rows(i).Shading.BackgroundPatternColor = _
wdColorLightBlue
.Rows(i - 1).Shading.BackgroundPatternColor = _
wdColorLightBlue
End If
sText = orng.Text
Next i
For i = .Rows.Count To 2 Step -1
If .Rows(i).Shading.BackgroundPatternColor _
<> wdColorLightBlue Then
.Rows(i).Delete
End If
Next i
'.Shading.BackgroundPatternColor = wdColorWhite
End With


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[JinkyJulie via OfficeKB.com]

Graham....

Thank you!!! That works brilliantly... I'll get the hang of this VBA yet!!!

I wish I knew about you guys months ago...

Thanks again.....

Julie....

 

[Graham Mayor]

You are welcome

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[JinkyJulie via OfficeKB.com]

Hi... Whoops... Spoke to soon...

There seems to be a problem with the calculation... If I am correct... The
calculation here is only dealing with the Minutes portion of the time in each
cell... therefore will only highlight cells where there is an actual
difference of 10 (the number) NOT 10 minutes in elapsed time....

(07:59 and 08:10 will not highlight but 12:30 and 12:53 will....)

I am researching to try to fix it myself, but I am stuck....


iMin = Minute(orng.Text) - Minute(sText)

If iMin >= 10 Then
.Rows(i).Shading.BackgroundPatternColor = _
wdLightBlue
.Rows(i - 1).Shading.BackgroundPatternColor = _
wdLightBlue
End If

Thanks again.....

Julie

 

[Graham Mayor]

Oops! (

See if you do any better with

iMin = (Hour(orng.Text) * 60 + Minute(orng.Text)) - _
(Hour(sText) * 60 + Minute(sText))


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[JinkyJulie via OfficeKB.com]

Graham...

You saved me again.... Thanks a great deal...... Works swimmingly....

Julie

 

[Graham Mayor]

You are welcome

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>