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

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

make sure that you have Options Explocit at th etop of
the module and that you
DIM MyHtm15 As String
you REM'd out the address & test. put them back,
otherwise your loop won't exit !
Note that each time that you do a find, the variable 'c'
is the cell found.

add this as well
dim text as string

we'll build the values in 'text' then add it to your main
string.


text = ""
for myoffset = 0 to 5
text = text & "," & c.offset(0,myoffset).Value
next myoffset
MyHtm15 = MyHtm15 & vbcr & mid(text,2)



note that here we build the 'text' string by adding
the ',' before each value. teh MID() function strips off
the preceding ',' as we don't need it....its easier that
stripping off a final ',' it it had been appended.

HTH
Patrick Molloy
Microsoft Excel MVP



-----Original Message-----
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


.

Me again, if you have a lot of data in the worksheet, using array makes code
faster.
I don't see your worksheet so it's not sure.. but which one is faster in
your case? :)

'---------------------------------------------------------------------------
-----
Dim MyHtm15 As String
Dim firstAddress As String
Dim buf As Variant
Dim i As Long
Dim c As Range

With Worksheets("New15Min")
.Activate
buf = .Range(.[A1], .[A65536].End(xlUp).Offset(, 6)).Value
End With
MyHtm15 = vbNullString: MyHtm15 = MyHtm15 & "</p"
With Columns(1)
Set c = .Find(Date, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
For i = 1 To 7
MyHtm15 = MyHtm15 & buf(c.Row, i)
Next
MyHtm15 = MyHtm15 & "</p"
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With
Set c = Nothing

'---------------------------------------------------------------------------
-----


--
Kind Regards
Colo
/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
Colo of 'The Road of The Cell Masters' :)

URL:http://www.interq.or.jp/sun/puremis/...astersLink.htm


/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/

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