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:
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:
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:
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
I'm not sure what the issue is. I have also tried first deleting the existing Named Range with no success.