CopyFromRecordset
code then would be record by record I'm afraid. I tried the worksheet
TRANSPOSE function but it failed
rst.MoveFirst
With rst
Do Until .EOF
For item = 0 To .Fields.Count - 1
target.Offset(item) = .Fields(item)
Next
.MoveNext
Set target = target.Offset(, 1)
Loop
End With
what you could do is a copyfromrecordset to a temp sheet then a pastespecial
transpose...
Set ws = Worksheets.Add
rst.MoveFirst
Set target = ws.Range("A1")
target.CopyFromRecordset rst
target.CurrentRegion.Resize(200).Copy
Worksheets("sheet10").Range("A1").PasteSpecial Paste:=xlPasteAll,
Transpose:=True
application.displayalerts=false
ws.delete
"Bam" wrote:
Hi Patrick,
I'm currently returning 3 fields for each row. These 3 fields go into
Columns C,D & E. When i get multiple results, they return each record down.
So say I return 2 results, then the 1st result goes into the ActiveRow (Row
2) & the next result goes into the row underneath. (Row 3)
Then the selection process goes to Row 3, and overwrites it.
My problem is the i need to record all results returned from the select
statement, in that same row. So if i get 2 results, i'd like the 2nd result
to go into F, G & H. 3 Results, the 3rd goes into I, J & K.
If i get 3 results, then i would have populated columns C through to K with
with 3 fields for each result.
I've tried all day to use Joels solution, which makes sense, but i just
can't get it to work.
Any help would be great.
Thanks.
Bam.
"Patrick Molloy" wrote:
I'm not really sure what you need. It sounds like you're requesting too many
fields if you only need three, then select just those three.
If you're looking at filtering for specific values in a certain field, then
the recordset has a filter method
eg where rst is an ADODB.Recordset object
rst.Filter = "stockNum=' & Range(stocknum) & " '"
so if your recordset has 1000 records, your filter may result in a subset of
these. Were you to use the range CopyFromRecordset now, you would get the
filtered result only.
does this help?
"Bam" wrote:
Hi All,
I'm having an issue where I would like to return all records based on a
cell, and copy them across columns until they stop finding a matching record.
The Select statement may return up to 4 or 5 values, but it is only using
the last value it finds, then moves down to the next row.
I want the 3 Fields for each record found to be put into the same row as the
strTargetStock, and keep repeating across the columns until the last record
is found.
I'm sure this is easy, but i've not been able to figure it out.
Any help would be appreciated.
Cheers,
Bam.
Option Explicit
Private con As Object
Private rst As Object
Sub ADOData(sSQL As String, rg As Range)
Dim sConn As String
Dim sheet As Worksheet
Dim ws As Worksheet
Set ws = ActiveSheet
On Error GoTo ErrHandler
'Create a new recordset object
Set con = CreateObject("ADODB.Connection")
'Set con = New ADODB.Connection
con.Open "Driver={SQL
Server};Server=SERVER;Database=DB171;Uid=USER;Pwd= PASSWORD;"
Set rst = CreateObject("ADODB.Recordset")
Set rst = con.Execute(sSQL, , 1)
rg.CopyFromRecordset rst
rst.Close
con.Close
'Clean up.
Set rst = Nothing
Set rg = Nothing
Exit Sub
ErrHandler:
MsgBox "Sorry,an error occured." & Err.Description & " " & sSQL, vbOKOnly
End Sub
Sub Customer()
Dim i As Integer
Dim c As Integer
Dim j As Byte
Dim intHowManyRow As Integer
Dim intStartRow As Integer
Dim intEndRow As Integer
Dim strTargetStock As String
Dim Customer As String
Dim DelCode As String
Dim Mysht As Worksheet
Set Mysht = ActiveSheet
intHowManyRow = Mysht.UsedRange.Rows.Count
intStartRow = 2
c = 3
intEndRow = intStartRow + intHowManyRow - 1
Range("C1") = "LM Code"
Range("D1") = "Width"
Range("E1") = "Length"
For i = intStartRow To intEndRow
strTargetStock = RTrim(LTrim((Cells(i, 1))))
Application.ScreenUpdating = False
Cells(i, 3).Select
'Call Data
If strTargetStock < "" Then
Call ADOData("SELECT IM_STOCK, IM_WIDE, IM_LEN " & _
"FROM IMI1 WITH (NOLOCK) " & _
"WHERE IM_CUST_STOCK = ('" & strTargetStock & "') AND
(IM_ACTIVE = 1)", Cells(i, c))
End If
Application.ScreenUpdating = True
Next i
ActiveCell.Select
End Sub
|