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