Make Named Range from a sql query on a view

jrdnoland · Dec 29th 2020

I'm running Excel vba 2016 code to make a Named Range from a query on SQL SERVER that is performed on a view. I have multiple tables in SQL SERVER that I'm doing this with. All of the ones that are run directly on a Table seem to work OK. I decided to make a few Views on data that would change more often thinking that the View would be updated when the data changed.

I'm not sure this is what's causing the issue, but it's the only thing that has changed.

Here are two subs that query the SQL SERVER, one for a table query the other for a View query.

This works fine:

Code

Public Sub Package_Type()
Dim SQL As String
SQL = ""
SQL = SQL & "SELECT DISTINCT [Package Type]"
SQL = SQL & " From rdLab.tblPackage_Type"
SQL = SQL & " WHERE (Package_Type_Is_Active = 1)"
SQL = SQL & " ORDER BY [Package Type]"
Call modDataValidation.GetDataFromSQL_SERVER("O2", "O", SQL, 12, "Package_Type", 1)
End Sub

This won't expand the Named Range:

Code

Public Sub Container()
Dim SQL As String
'viewContainers is a view made from dbo.BomInfo
SQL = ""
SQL = SQL & "SELECT DISTINCT MATERIAL_COMPONENT, MATERIAL_DESCRIPTION_COMPONENT"
SQL = SQL & " From dbo.viewCONTAINERS"
SQL = SQL & " ORDER BY MATERIAL_COMPONENT"
Call modDataValidation.GetDataFromSQL_SERVER("P2", "Q", SQL, 13, "Containers", 2)
End Sub

Here is the sub that runs the query and changes the Named Range:

Code

Sub GetDataFromSQL_SERVER(StartCol As String, EndCol As String, SQL As String, FdStart As Integer, NmeRng As String, ColReSize As Integer)
Dim objMyConn As Connection
Dim objMyCmd As Command
Dim objMyRecordset As Recordset
Dim recArray As Variant
Dim recCount As Long
Dim iCol As Integer
Dim iRow As Integer
Dim fldCount As Integer
Dim xlsht As Excel.Worksheet
Dim LastRow As Long
Dim nRng As Name
Dim rc As Long
Dim xWb As Workbook
Dim xNameString As String
Dim xName As Name
On Error GoTo errhandler:
'Declare variables'
Set objMyConn = New ADODB.Connection
Set objMyCmd = New ADODB.Command
Set objMyRecordset = New ADODB.Recordset
Set xlsht = ThisWorkbook.Worksheets("Lists")
'delete space for new list
With xlsht
LastRow = Cells(Rows.Count, EndCol).End(xlUp).Row
End With
Application.EnableEvents = False
xlsht.Range(StartCol & ":" & EndCol & LastRow).ClearContents
'Open Connection'
objMyConn.ConnectionString = "Provider=SQLOLEDB;Data Source=DLTest_SQL;Initial Catalog=DLTest;Integrated Security=SSPI;"
objMyConn.Open
'Set and Excecute SQL Command'
Set objMyCmd.ActiveConnection = objMyConn
objMyCmd.CommandText = SQL
objMyCmd.CommandType = adCmdText
objMyCmd.Execute
'Open Recordset'
Set objMyRecordset.ActiveConnection = objMyConn
objMyRecordset.Open objMyCmd
'Copy Field Names to worksheet
fldCount = objMyRecordset.Fields.Count
For iCol = 1 To fldCount
Worksheets("Lists").Cells(1, FdStart).Value = objMyRecordset.Fields(iCol - 1).Name
Next
'Copy Data to Excel'
Worksheets("Lists").Range(StartCol).CopyFromRecordset objMyRecordset
rc = Worksheets("Lists").Cells(Rows.Count, 1).End(xlUp).Row
objMyConn.Close
Worksheets("Lists").Activate
'Update Named Range
With xlsht
LastRow = Cells(Rows.Count, EndCol).End(xlUp).Row
End With
Set xWb = Application.ActiveWorkbook
xNameString = NmeRng
Set xName = xWb.Names.Item(xNameString)
With xName
.RefersTo = .RefersToRange.Resize(LastRow, ColReSize) 'RowSize, ColumnSize
End With
Exit Sub
errhandler:
MsgBox err.Number & " " & err.Description
End Sub

Display More

I'm not sure what the issue is. I have also tried first deleting the existing Named Range with no success.

Thanks,

Jeff

Make Named Range from a sql query on a view

Share

Tags