Hello Philips,

Dim MyHtm15 As String
Dim firstAddress As String
Dim i As Long
Dim c As Range

ThisWorkbook.Sheets("New15Min").Activate
With Worksheets("New15Min").Range("a1:a64000")
MyHtm15 = ""
MyHtm15 = MyHtm15 & "</p"
Set c = .Find(Date, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
For i = 0 To 6
MyHtm15 = MyHtm15 & c.Offset(0, i).Value
Next
MyHtm15 = MyHtm15 & "</p"
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
Set c = Nothing
End With


"Phillips" wrote in message
news:78zBb.492342$Tr4.1344946@attbi_s03...
I am tring to build up a text string of cells a-g for all rows that have
todays date in col A
The code below is what I have come up with, but it seems to hang...
Help and TIA
Phil


"****************
ThisWorkbook.Sheets("New15Min").Activate

With Worksheets("New15Min").Range("a1:a64000")
MyHtm15 = ""
MyHtm15 = MyHtm15 & "</p"
Set c = .Find(Date, LookIn:=xlValues)
If Not c Is Nothing Then
'firstAddress = c.Address
Do
MyHtm15 = MyHtm15 & ActiveCell(0, 0) & ActiveCell(0, 1) &
ActiveCell(0, 2) & ActiveCell(0, 3) & ActiveCell(0, 4) & ActiveCell(0, 5)
&
ActiveCell(0, 6) & "</p"

'c.Value = 5
Set c = .FindNext(c)
Loop While Not c Is Nothing 'And c.Address < firstAddress
End If
End With