Highlighting, freezing and scrolling

[kellyhell]

Little bit stumped with this one.

I have some code that highlights the cell showing today's date.

The code then freezes at column H. The cell with today's date could be 6 or 7 columns away.

Does anyone know of code that will scroll to make the column,with the highlighted cell, to the end of the freeze? Also I would like the whole column bordered in red?

My code is:

Private Sub Workbook_Open()
'first make sure the correct
'sheet is active and ready to be used
'this sheet must be visible
ThisWorkbook.Worksheets("Timeline").Visible = xlSheetVisible
ThisWorkbook.Worksheets("Timeline").Activate
ActiveSheet.Range("H2").Activate
ActiveSheet.Cells.Find(What:=Date, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Interior.Color = vbGreen
Columns("H:H").Select
    ActiveWindow.FreezePanes = True
   End Sub

Thanks in advance

[p45cal]

ThisWorkbook.Worksheets("Timeline").Visible = xlSheetVisible
ThisWorkbook.Worksheets("Timeline").Activate
ActiveSheet.Range("H2").Activate
Set AC = ActiveSheet.Cells.Find(What:=Date, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)  '.Activate

With AC
  .Interior.Color = vbGreen
  .EntireColumn.BorderAround xlContinuous, xlThick, , -16776961
  .EntireColumn.Select
  ActiveWindow.FreezePanes = True
  .Select
End With