[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 220
  • Last Modified:

Put array in .NoteText like text

Hello experts.

Please help me to print array sArray directly to .NoteText with tab (for example).
Should I only loop array or it is possible to use something like php: foreach etc.?

I receive array from ADODB.Recordset after .GetRows

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

above example puts only last element of array..
If possible please help coding this issue.

Regards, juwdoks.
0
juwdoks
Asked:
juwdoks
  • 7
  • 6
  • 4
4 Solutions
 
[ fanpages ]IT Services ConsultantCommented:
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.
0
 
[ fanpages ]IT Services ConsultantCommented:
PS. For future MS-Excel related questions you may find a faster response in this Topic Area:

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

BFN,

fp.
0
 
juwdoksAuthor Commented:
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.
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
[ fanpages ]IT Services ConsultantCommented:
So, sArray is a multi-dimension array?

What have you declared sArray as in your code?  [or perhaps you have not declared it at all].

Try this:

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


I'm only guessing here as it's difficult without having site of all (the relevant parts) of your existing code.

BFN,

fp.
0
 
juwdoksAuthor Commented:
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.
0
 
juwdoksAuthor Commented:
Concerning your last code - I receive again last element of array between unreadable characters... (not Tab).

Regards, juwdoks.
0
 
[ fanpages ]IT Services ConsultantCommented:
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.
0
 
EDDYKTCommented:
can you use getstring instead?


ie

s = rs .GetRows

Cells(c.Cells.Row, c.Cells.Column + 38).NoteText Replace(s, vbCr, vbCrLf)
0
 
juwdoksAuthor Commented:
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.
0
 
EDDYKTCommented:
sorry use getstring

dim s as string


s = rs.getstring(adClipString, -1, vbtab, vbcrlf)

Cells(c.Cells.Row, c.Cells.Column + 38).NoteText s
0
 
[ fanpages ]IT Services ConsultantCommented:
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?
0
 
juwdoksAuthor Commented:
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.
0
 
juwdoksAuthor Commented:
fanpages,

Same result :( Only last element..
0
 
EDDYKTCommented:
1. you can use split function to break down the string


i.e

arr = split(s, vbcrlf)
for i=1 to ubound(arr)
    split(arr(0), vbtab)
next

etc

2. basically you just insert comment into the cell

you can use


Range("B2").Comment.Text Text:=s
Selection.ShapeRange.ScaleWidth 3.94, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 3.11, msoFalse, msoScaleFromTopLeft


etc
0
 
juwdoksAuthor Commented:
EDDYKT,

Thanks, I am trying what you wrote, but please advise how to use .GetRows and .GetString for one rs..
0
 
EDDYKTCommented:
what do you mean?


s = rs.getstring(adClipString, -1, vbtab, vbcrlf)

rs.movefirst

arr = rs.getrows
0
 
[ fanpages ]IT Services ConsultantCommented:
Thanks for closing the question... but I have to admit I'm not quite sure what you used & how.
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

  • 7
  • 6
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now