Bus Schedule

Location: http://www.mvps.org/dmcritchie/excel/bus_sched.htm Home page: http://www.mvps.org/dmcritchie/excel/excel.htm [View without Frames]

Bus Schedule with PM times as boldface

This page contains some VBA macros. If you need assistance to install or to use a macro please refer to my GetFormula page.

You cannot specify boldface in regular cell formatting. Conditional Formatting could do the boldface but that is all. A macro is needed to change the time and formatting so that that 1:00 and 13:00 both appear as 1:00 with the PM appearing in bold, and both without AM or PM. Example:

Original Bus Schedule Sheet

A B C D

1 Tour A Tour A Tour B Tour B

2 0:00 Point A 5:00 Point G

3 8:00 Point B 7:00 Point F

4 12:00 Point C 12:00 Point E

5 13:00 Point D 16:00 Point D

6 17:00 Point E 17:00 Point C

7 22:00 Point F 21:00 Point B

8 0:00 Point G 5:00 Point A

New Bus Schedule Sheet

A B C D

1 Tour A Tour A Tour B Tour B

2 0:00 Point A 5:00 Point G

3 8:00 Point B 7:00 Point F

4 12:00 Point C 12:00 Point E

5 1:00 Point D 4:00 Point D

6 5:00 Point E 5:00 Point C

7 10:00 Point F 9:00 Point B

8 0:00 Point G 5:00 Point A

A copy of the sheet is made. The new sheet will have values between .5 and 1 reformatted as PM in bold. Hours from 1 PM to midnight will have 12 hours subtracted because single digit hours are wanted.
Option Explicit
Sub Bus_Sched()
'Bus Schedule  2001-04-17  in misc
'David McRitchie  http://www.mvps.org/dmcritchie/excel/excel.htm
' show times as  0:00 1:00 12:00 1:00  with PM in bold
' uses a second sheet to accomplish this
Dim nCol As Long, nRow As Long
Dim cRow As Long
Dim lastrow As Double
Dim wsSource As Worksheet
Dim wsNew As Worksheet
Set wsSource = ActiveSheet
Dim iCell As String
Dim cell As Range
Dim oValue As Single
Sheets(ActiveSheet.Name).Copy After:=Sheets(ActiveSheet.Name)
Set wsNew = ActiveSheet
wsSource.Activate
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual 'xl95 uses xlManual
For Each cell In Cells.SpecialCells(xlCellTypeConstants, 1)
   oValue = cell.Value
   iCell = cell.Address(0, 0)
   If oValue < 1 Then   'test for time less than a day
     If oValue >= 12 / 24 Then
       wsNew.Range(iCell).Font.Bold = True
       If oValue >= 13 / 24 Then oValue = oValue - 0.5
       wsNew.Range(iCell) = "'" & _
         Trim(Left(Format(oValue, "h:mm    a/p"), 5))
       wsNew.Range(iCell).HorizontalAlignment = xlRight
    Else
       wsNew.Range(iCell).NumberFormat = "h:mm"
       wsNew.Range(iCell).HorizontalAlignment = xlRight
    End If
  End If
Next cell
Application.Calculation = xlCalculationAutomatic 'xl95 uses xlAutomatic
Application.ScreenUpdating = True
End Sub
This code is also available in a separate file.

(placeholder)

You are one of many distinguished visitors who have visited my site here or in a previous location since this page was created on December 16, 2000.

Visit [my Excel home page] [Index page] [Excel Onsite Search] [top of this page]

Please send your comments concerning this web page to: David McRitchie send email comments

Bus Schedule

Bus Schedule with PM times as boldface

Related