Put array in .NoteText like text

Hi,

Assuming sArray is an array with a data type of String:

Dim lngLoop As Long
Dim strNoteText As String

strNoteText = ""
For lngLoop = LBound(sArray) To UBound(sArray) ' * see below
    strNoteText = IIF(Len(strNoteText)>0,vbTab,"") & sArray(lngLoop)
Next lngLoop

Cells(c.Cells.Row, c.Cells.Column + 38).NoteText strNoteText


' * Note:
You may wish to change this to:
For lngLoop = 1& To UBound(sArray)

To skip the first (zero-relative) entry in the array.

BFN,

fp.

PS. For future MS-Excel related questions you may find a faster response in this Topic Area:

[ https://www.experts-exchange.com/Applications/MS_Office/Excel/ ]

BFN,

fp.

This code gives Subscript out of range..

strNoteText = IIF(Len(strNoteText)>0,vbTab,"") & sArray(lngLoop)

sArray receved from MSAccess is like the following:

Dbl      OperatorName      SpoNumber
1298      Karya      Kar Ayt6 072
1378      Turtess      Ayt6 045
1389      Turtess      Ayt6 036
1426      Tez tour      Tez Ayt6 069
1436      Tez tour      Tez Ayt6 037
1480      Karya      Kar Ayt6 055
1537      Pegas      Peg Ayt6 381
1543      Pegas      Peg Ayt6 421

Regards, juwdoks.

Yes, array is multi-dimension, sorry. Actually I declare it as Variant. Below is everything I have for this moment (Function DoubleQuotes is omitted):

Sub FillExactCompetitors()

Dim cn As ADODB.Connection
Dim HotelName As String
Dim RoomName As String
Dim ViewName As String
Dim Departure As Date
Dim Nights As Integer
Dim BoardName As String
Dim sArray As Variant

Set cn = New ADODB.Connection
cn.Open ("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=\\Kiev\Analysis\Analysis.mdb;Persist Security Info=False")

With Selection.Cells
Set iClear = Selection.Cells.Offset(rowOffset:=0, columnOffset:=38)
    With iClear
        .ClearContents
        .ClearNotes
        .Interior.ColorIndex = 0
    End With
End With

For Each c In Selection.Cells

    If IsNumeric(c.Value) And Not IsNull(c.Value) And Not IsEmpty(c.Value) Then
   
    HotelName = Cells(c.Cells.Row, 2).Value
    RoomName = Cells(c.Cells.Row, 4).Value
    ViewName = Cells(c.Cells.Row, 5).Value
    Departure = Cells(c.Cells.Row, 1).Value
    BoardName = Cells(1, c.Cells.Column).Value
    Nights = 7

        Set rs = New ADODB.Recordset
            With rs
                .ActiveConnection = cn
                QueryString = "SELECT Main.Dbl, Operators.OperatorName, Spo.SpoNumber  " + _
                    "FROM Boards INNER JOIN (Operators INNER JOIN (Spo INNER JOIN (Views INNER JOIN (Rooms INNER JOIN (Stars INNER JOIN (Hotels INNER JOIN Main ON Hotels.HotelId = Main.HotelId) ON Stars.ID_s = Hotels.StarId) ON Rooms.RoomId = Main.RoomId) ON Views.ViewId = Main.ViewId) ON Spo.SpoId = Main.SpoId) ON Operators.OperatorId = Spo.OperatorId) ON Boards.BoardId = Main.BoardId  " + _
                    "GROUP BY Main.Dbl, Operators.OperatorName, Spo.SpoNumber, Boards.BoardName, Hotels.HotelName, Rooms.RoomName, Views.ViewName, Main.Departure, Main.Nights  " + _
                    "HAVING (((Boards.BoardName)='" & BoardName & "') AND ((Hotels.HotelName)='" & DoubleQuotes(HotelName) & "') AND ((Rooms.RoomName)='" & RoomName & "') AND ((Views.ViewName)='" & ViewName & "') AND ((Main.Departure)=#" & Format(Departure, "yyyy-mm-dd") & "#) AND ((Main.Nights)=7))  " + _
                    "ORDER BY Main.Dbl"
                    .Open QueryString
            End With
           
                While rs.State = 0
                    Set rs = rs.NextRecordset
                Wend
               
                If Not rs.EOF Then
                    sArray = rs.GetRows
                    DblMin = sArray(0, 0)
                    Cells(c.Cells.Row, c.Cells.Column + 38).Value = DblMin
                        If sArray(1, 0) = "Turtess" Then
                            Cells(c.Cells.Row, c.Cells.Column + 38).Interior.ColorIndex = 35
                        Else
                            Cells(c.Cells.Row, c.Cells.Column + 38).Interior.ColorIndex = 40
                        End If
                   
                    Dim intColumn As Integer
                    Dim lngRow As Long
                    Dim strNoteText As String
                   
                    strNoteText = ""
                    For lngRow = LBound(sArray, 2) To UBound(sArray, 2)
                        For intColumn = LBound(sArray, 1) To UBound(sArray, 1)
                            strNoteText = IIf(Len(strNoteText) > 0, vbTab, "") & sArray(intColumn, lngRow)
                        Next intColumn
                        strNoteText = strNoteText & vbCrLf
                    Next lngRow
                   
                    Cells(c.Cells.Row, c.Cells.Column + 38).NoteText strNoteText
                   
                End If
               
                rs.Close
                Set rs = Nothing

    End If

Next

End Sub

Regards, juwdoks.

Concerning your last code - I receive again last element of array between unreadable characters... (not Tab).

Regards, juwdoks.

The "unreadable characters" are probably vbCr (Carriage Return) & vbLf (Line Feed) from this line:
strNoteText = strNoteText & vbCrLf


To try to discover what you are seeing, replace this line:
Cells(c.Cells.Row, c.Cells.Column + 38).NoteText strNoteText

With:
Debug.Print strNoteText

And then post the contents of the resultant "Immediate" window to another comment.

Thanks.

BFN,

fp.

can you use getstring instead?


ie

s = rs .GetRows

Cells(c.Cells.Row, c.Cells.Column + 38).NoteText Replace(s, vbCr, vbCrLf)

fanpages,

Immediate Window receives only last element of the array.. from Debug.Print strNoteText.

EDDYKT,

sArray = rs .GetRows
Replace(sArray, vbCr, vbCrLf)

Causes Type Mismatch Error..

Regards, juwdoks.

Let's try reversing the array looping:
 
                    strNoteText = ""

                    For intColumn = LBound(sArray, 1) To UBound(sArray, 1)
                        For lngRow = LBound(sArray, 2) To UBound(sArray, 2)
                            strNoteText = IIf(Len(strNoteText) > 0, vbTab, "") & sArray(intColumn, lngRow)
                        Next lngRow
                    Next intColumn
                    strNoteText = strNoteText & vbCrLf
                   
                    Cells(c.Cells.Row, c.Cells.Column + 38).NoteText strNoteText
                    Debug.Print strNoteText

Any difference?

EDDYKT,

It works!
Please advise how to solve last points:

1. I need .GetRows also because I am taking Min value in it and checking OperatorName value as well. But after .GetString rs becomes emty..

2. When I put s to .NoteText it looks terrible:
http://www.alx.com.ua/_files/20060601.NoteText.gif
- I want to resize NoteText to suite text
- I want to avoid those squares..

Please advise.

fanpages,

Same result :( Only last element..

EDDYKT,

Thanks, I am trying what you wrote, but please advise how to use .GetRows and .GetString for one rs..

Thanks for closing the question... but I have to admit I'm not quite sure what you used & how.