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.
Thanks,
Jeff