We help IT Professionals succeed at work.

Excel - VBA - DAO

1,715 Views
Last Modified: 2013-12-25
I need to get a recorset from Oracle into one and only one cell in Excel.  This will show a count of the top 5 incidents

Field 1             Field 2
Blackberry         5
Outlook              2

And so forth until 5 have been reached how do I get it to put this in one cell... For something which should be so easy its caused me nothing but headaches.  

Comment
Watch Question

CERTIFIED EXPERT
Top Expert 2010

Commented:
Why just one cell?  This will kill your ability to do analysis on the info.

If you can allow more than one cell to be populated, Excel has a very handy and easy
CopyFromRecordset method for the Range object...

Author

Commented:
Matthew I know how to copy the recordset for some reason they want to see this as a mini list of the top 5 incidents.  and are not really bothered about analysis.
CERTIFIED EXPERT
Top Expert 2010

Commented:
BPMonk,

IMHO, your users are crazy for asking for this :)

Assuming you already have the top N results in a recordset object:

Dim StrFromRs As String

With rs
    .MoveFirst
    StrFromRs = "Field 1" & Space(8) & "Field 2"
    Do Until .EOF
        StrFromRs = StrFromRs & Chr(10) & rs.Fields(0) & _
            Space(15 - Len(rs.Fields(0)) & rs.Fields(1)
        .MoveNext
    Loop
    .Close
End With
Set rs = Nothing

With [a1]
    .Value = StrFromRs
    .WrapText = True
End With
Columns.AutFit
Rows.AutoFit

Regards,

Patrick

Author

Commented:
Ive basically got the query to output on specific location on the spreadsheet if thats what u mean, I seem to be getting errors here

StrFromRs = StrFromRs & Chr(10) & rs.Fields(0) & _
            Space(15 - Len(rs.Fields(0)) & rs.Fields(1)

Its showing red

Heres my code for getting the results


'Run the SQL
   
     StrSQL = "SELECT count (DISTINCT PROBSUMMARYM1.NUMBERPRGN) AS Occurance, PROBSUMMARYM1.PROBLEM_TYPE FROM PROBSUMMARYM1, PROBSUMMARYM2 WHERE PROBSUMMARYM1.NUMBERPRGN=PROBSUMMARYM2.NUMBERPRGN AND PROBSUMMARYM2.BARCLAYS_ORIGINATING_TEAM IN ('BDSINC','BDSIR') AND PROBSUMMARYM1.CLOSE_TIME BETWEEN TIMESTAMP '" & strstartdate & "' And TIMESTAMP '" & strdatefinish & "' GROUP BY PROBSUMMARYM1.PROBLEM_TYPE ORDER BY Occurance DESC"
   
    'Open connection to the database
     cnt.Open glob_sConnect
     
    'Open recordset based on Orders table
     rst.Open StrSQL, cnt
     
    'Set the Position on the spreadsheet
     Set posit = Worksheets("BDS+").Cells(50, NCell).Merge
CERTIFIED EXPERT
Top Expert 2010

Commented:
Keep the variables consistent; stick with rs or rst, but not both :)

Author

Commented:
I have mate, Im dumb but not that dumb lol, also I may get a data mismatch as one field is numerical the other text.  Just ran it and od get data msimatch herees the code

Dim cnt As New ADODB.Connection

    With cnt
   
    .ConnectionString = glob_sConnect
    .ConnectionTimeout = 20
    .CommandTimeout = 1000
   
    End With
   
    Dim rst As New ADODB.Recordset
    Dim StrSQL As String
    Dim posit As Range
    Dim MyDate As Integer
    Dim MCell As Integer
    Dim SCell As Integer
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim NCell As Integer
    Dim StrFromRs As String
   
    StrSQL = "SELECT count (DISTINCT PROBSUMMARYM1.NUMBERPRGN) AS Occurance, PROBSUMMARYM1.PROBLEM_TYPE FROM PROBSUMMARYM1, PROBSUMMARYM2 WHERE PROBSUMMARYM1.NUMBERPRGN=PROBSUMMARYM2.NUMBERPRGN AND PROBSUMMARYM2.BARCLAYS_ORIGINATING_TEAM IN ('BDSINC','BDSIR') AND PROBSUMMARYM1.CLOSE_TIME BETWEEN TIMESTAMP '" & strstartdate & "' And TIMESTAMP '" & strdatefinish & "' GROUP BY PROBSUMMARYM1.PROBLEM_TYPE ORDER BY Occurance DESC"
   
    cnt.Open glob_sConnect
    rst.Open StrSQL, cnt
   

    With rst
     
    .MoveFirst
   
    StrFromRs = "Field 1" & Space(8) & "Field 2"
   
    Do Until .EOF
   
           StrFromRs = StrFromRs & Chr(10) & rst.Fields(0) & Space(15 - Len(rst.Fields(0)) & rst.Fields(1))
           
        .MoveNext
    Loop
    .Close
   
End With

Set rst = Nothing

With [a1]
    .Value = StrFromRs
    .WrapText = True
End With


Columns.AutFit
Rows.AutoFit
   
    ''Set Variables
    MCell = 2
   
    '' Position the cells
   
    i = Day(Now())
    j = Day(strstartdate2)
    k = i - (i - j)
   
    NCell = MCell + k
   
    ''Run the SQL
   
     StrSQL = "SELECT count (DISTINCT PROBSUMMARYM1.NUMBERPRGN) AS Occurance, PROBSUMMARYM1.PROBLEM_TYPE FROM PROBSUMMARYM1, PROBSUMMARYM2 WHERE PROBSUMMARYM1.NUMBERPRGN=PROBSUMMARYM2.NUMBERPRGN AND PROBSUMMARYM2.BARCLAYS_ORIGINATING_TEAM IN ('BDSINC','BDSIR') AND PROBSUMMARYM1.CLOSE_TIME BETWEEN TIMESTAMP '" & strstartdate & "' And TIMESTAMP '" & strdatefinish & "' GROUP BY PROBSUMMARYM1.PROBLEM_TYPE ORDER BY Occurance DESC"
   
    'Open connection to the database
     'cnt.Open glob_sConnect
     
    'Open recordset based on Orders table
     'rst.Open StrSQL, cnt
     
    'Set the Position on the spreadsheet
     Set posit = Worksheets("BDS+").Cells(50, NCell).Merge
     

Author

Commented:
Im getting a type mismatch here
CERTIFIED EXPERT
Top Expert 2010

Commented:
BPMonk,

What line does the debugger jumo to?

Regards,

Patrick

Author

Commented:
Ok well I keep getting red with the &_ but when I put

StrFromRst = StrFromRst & Chr(10) & rst.Fields(0) & Space(15 - Len(rst.Fields(0)) & rst.Fields(1)

The red goes but it seems to be this causing the problem am I putting my SQL etc in the right places?

 
CERTIFIED EXPERT
Top Expert 2010
Commented:
Unlock this solution and get a sample of our free trial.
(No credit card required)
UNLOCK SOLUTION

Author

Commented:
I did that mate and also added a bracket I have it black now but still getting type mismatch.

Author

Commented:
Thanks Matt, I messed about with the String and got it to work...  Also helped me get my head around recordsets a bit which when you do its not so bad after all :)  Thanks A Million...
Unlock the solution to this question.
Thanks for using Experts Exchange.

Please provide your email to receive a sample view!

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.