I built the below as a tool to automate some data entry for multiple workbooks at work that references the same centralized .xla file for some custom functions, etc.
The code worked perfectly when I initially build the range checking and initial value checks into the worksheet object, but once I moved it to a module, it's gone rather crazy. I could simply move it back to the worksheet objects, but I was hoping to keep it centralized, so I wouldn't have so much duplication of code.
The highlighted line in the bottom procedure for some reason causes the code to loop back to the second function (also highlighted) rather than just look to the recordset object created within the current procedure. Can anyone point out what I"m missing? What did I break? Thanks for any thoughts.
[CODE VBA]
[BOLD][GREEN]‘WITHIN THE CURRENTLY OPENED WORKBOOK:[/GREEN][/BOLD]
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Range(Target.Address), ActiveWorkbook.ActiveSheet.Range("WorkingList")) Is Nothing Then
Else
BarCodeQuery Target
End If
End Sub
[BOLD][GREEN]‘NEXT 2 PROCEDURES IN A MODULE OF .XLA FILE[/GREEN][/BOLD]
[highlight #FCE94F]Sub BarCodeQuery(Target As Range)[/highlight]
If Target.Value Like "####*[-]##[ ][a-z]" Or _
Target.Value Like "####*[-]##" Or _
Target.Value Like "####*[-]##[ ][A-Z]" Then
[GREEN] ' # = Number
' * = Wildcard[/GREEN]
ConnectSqlServer Target [GREEN]' Call code to grab values from SQL Server[/GREEN]
Else
End If
End Sub
Sub ConnectSqlServer(InputRange As Range)
Dim conn As Object [GREEN]' Late Binding[/GREEN]
Dim rs As Object [GREEN]'Late Binding[/GREEN]
Dim sConnString As String
Dim strSQL As String
sConnString = "Provider=SQLOLEDB;Data Source=SERVER;" & _
"Initial Catalog=DATABASE;" & _
"User Id=SqlUserID;" & _
"Password=SqlUserPassword;"
'"Integrated Security=SSPI;"
Set conn = CreateObject("ADODB.Connection") [GREEN]' Late Binding[/GREEN]
Set rs = CreateObject("ADODB.Recordset") [GREEN]' Late Binding[/GREEN]
conn.Open sConnString
[GREEN] ' Added "TOP 1" for certain circumstances[/GREEN]
strSQL = "SELECT TOP 1 Field1, Field2, Field3”
strSQL = strSQL & "FROM Database.dbo.Tablec WITH (NOLOCK)"
strSQL = strSQL & "WHERE MyConditions”
Set rs = conn.Execute(strSQL)
If Not rs.EOF Then
[highlight #FCE94F] InputRange = rs.Fields("Field1")[/highlight]
InputRange.Offset(, 1) = rs.Fields("Field2")
InputRange.Offset(, 2) = rs.Fields("Field3")
[GREEN] ' Close the recordset[/GREEN]
rs.Close
Else
Msgbox "Error: No records returned.", vbCritical
End If
[GREEN] ' Clean up[/GREEN]
If CBool(conn.State And adStateOpen) Then conn.Close
Set conn = Nothing
Set rs = Nothing
End Sub
[/CODE]
"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57
The code worked perfectly when I initially build the range checking and initial value checks into the worksheet object, but once I moved it to a module, it's gone rather crazy. I could simply move it back to the worksheet objects, but I was hoping to keep it centralized, so I wouldn't have so much duplication of code.
The highlighted line in the bottom procedure for some reason causes the code to loop back to the second function (also highlighted) rather than just look to the recordset object created within the current procedure. Can anyone point out what I"m missing? What did I break? Thanks for any thoughts.
[CODE VBA]
[BOLD][GREEN]‘WITHIN THE CURRENTLY OPENED WORKBOOK:[/GREEN][/BOLD]
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Range(Target.Address), ActiveWorkbook.ActiveSheet.Range("WorkingList")) Is Nothing Then
Else
BarCodeQuery Target
End If
End Sub
[BOLD][GREEN]‘NEXT 2 PROCEDURES IN A MODULE OF .XLA FILE[/GREEN][/BOLD]
[highlight #FCE94F]Sub BarCodeQuery(Target As Range)[/highlight]
If Target.Value Like "####*[-]##[ ][a-z]" Or _
Target.Value Like "####*[-]##" Or _
Target.Value Like "####*[-]##[ ][A-Z]" Then
[GREEN] ' # = Number
' * = Wildcard[/GREEN]
ConnectSqlServer Target [GREEN]' Call code to grab values from SQL Server[/GREEN]
Else
End If
End Sub
Sub ConnectSqlServer(InputRange As Range)
Dim conn As Object [GREEN]' Late Binding[/GREEN]
Dim rs As Object [GREEN]'Late Binding[/GREEN]
Dim sConnString As String
Dim strSQL As String
sConnString = "Provider=SQLOLEDB;Data Source=SERVER;" & _
"Initial Catalog=DATABASE;" & _
"User Id=SqlUserID;" & _
"Password=SqlUserPassword;"
'"Integrated Security=SSPI;"
Set conn = CreateObject("ADODB.Connection") [GREEN]' Late Binding[/GREEN]
Set rs = CreateObject("ADODB.Recordset") [GREEN]' Late Binding[/GREEN]
conn.Open sConnString
[GREEN] ' Added "TOP 1" for certain circumstances[/GREEN]
strSQL = "SELECT TOP 1 Field1, Field2, Field3”
strSQL = strSQL & "FROM Database.dbo.Tablec WITH (NOLOCK)"
strSQL = strSQL & "WHERE MyConditions”
Set rs = conn.Execute(strSQL)
If Not rs.EOF Then
[highlight #FCE94F] InputRange = rs.Fields("Field1")[/highlight]
InputRange.Offset(, 1) = rs.Fields("Field2")
InputRange.Offset(, 2) = rs.Fields("Field3")
[GREEN] ' Close the recordset[/GREEN]
rs.Close
Else
Msgbox "Error: No records returned.", vbCritical
End If
[GREEN] ' Clean up[/GREEN]
If CBool(conn.State And adStateOpen) Then conn.Close
Set conn = Nothing
Set rs = Nothing
End Sub
[/CODE]
"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57