Sub GetPartList()
Dim sPath As String, sDB As String
Dim sConn As String, sSQL As String
sPath = "\\bhdfwfp426.bh.textron.com\M_Ctr$\#MCOE Lean Mfg Database"
sDB = "DSC PQPR's"
sConn = "ODBC;DSN=MS Access Database;"
sConn = sConn & "DBQ=" & sPath & "\" & sDB & ".mdb;"
sConn = sConn & "DefaultDir=" & sPath & ";"
sConn = sConn & "DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;"
sSQL = "SELECT DISTINCT `Part Number` "
sSQL = sSQL & "FROM `" & sPath & "\" & sDB & "`.xTBLAllPartsAtCells "
sSQL = sSQL & "Where Cells='" & [SelectedCell] & "' "
With wsPartList
With .QueryTables(1)
.Connection = sConn
.CommandText = sSQL
.Refresh BackgroundQuery:=False
End With
Application.DisplayAlerts = False
.[A1].CurrentRegion.CreateNames _
Top:=True, Left:=False, Bottom:=False, Right:=False
Application.DisplayAlerts = True
End With
End Sub