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

Colo,

Thank you very much!
This does what I wanted, however, the results are not as "neat" as I hoped
for,,,
I am trying to build up an email. How could I insert this in the middle of
my email as "formatted" or as a table? I also tried formatting using vbtab,
but that did not do much..

Again, I thank you, just I thought I would be happy with the results I would
have gotten, but, it don't look pretty...
Phil



"Colo" wrote in message
...
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