R
Rey
Howdy all. Long post...
Trying to get new names added to worksheet using following steps:
1. obtain list of buyer names from [RLS BYR Name] column that exists
in a worksheet (tbl_imported_data) and are not currently in [SVBuyers]
column of another worksheet (Buyers and Codes) in the same workbook
using an SQL Not In query.
2. Next is to check the above names against the [Name] column of
worksheet Buyers and Coders that is used to autofilter and
subsequently delete respective rows from worksheet tbl_imported_data
as part of a different method.
3. Finally, the remaining names will be displayed to user as new
buyer names for them to either add to the [SVBuyer] column or the
[Name] column.
Whew...
My problem is that I get no rows returned in the recordset from the
NOT IN SQL statement:
' [Buyers] is 2nd column in worksheet
strSql = "SELECT DISTINCT [RLS BYR Name] AS NewName FROM
[tbl_imported_data$] "
strSql = strSql & "WHERE [RLS BYR Name] NOT IN "
strSql = strSql & "(SELECT [Buyers] FROM [Buyers and Codes$])"
If I separate the statement into 2 select statements (one for
SVBuyers, one for distinct RLS Byr Name) I get 2 recordsets with rows.
As part of troubleshooting - don't recall why I tried this - I added
another sheet to which I copied the SVBuyers column as the only column
(leftmost column). I then ran the NOT IN query and this time it
returned records.
Is this correct or am I missing something? I've not come across
anything mentioning the need to use the first column position in a
worksheet for a SQL query. Currently using this workaround and am now
at step of displaying new names via UserForm vice current msgBox.
Thank you for your comments and suggestions,
Rey
****************************************************************************
Option Explicit
Sub GetNewBuyerNames()
' 1/11/2008, Rey Collazo
'purpose: access column/range in worksheet and
' display names not currently in buyers and codes sheet,
name column
' pseudo: open wrksheet, get range of current buyers, get unique
buyers from buyer name colu
' from worksheet, get not in current buyers names, display
to user
' then append to end of current buyer column and then run
filter macro
Dim thisWrkBook As Workbook
Dim buyerSheet As Worksheet
Dim rngCurrentBuyers As Range
Dim strNewNames As String
Dim arNewNames() As String 'array of new names
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strSql As String
Dim strConnection As String
Dim lngRecCount As Long
Dim x As Long
Dim rs_Clone As New ADODB.Recordset
Dim strNewBuyers As String
' test to get data from indiv columns
Dim rsSVBuyers As New ADODB.Recordset ' from svBuyers column of
Buyers and Codes sheet
Dim rsRLSByr As ADODB.Recordset ' from tbl_imported_data
sheet rls byr name column
Dim rst As New ADODB.Recordset
strNewNames = ""
strNewBuyers = ""
strConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=M:\Admin_Information
\tbl_imported_data_testing.xls;" & _
"Extended Properties=""Excel 8.0;"""
With conn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = strConnection
.CursorLocation = adUseClient ' needed else rs contains nothing
-1
.Open
End With
Application.DisplayStatusBar = True
' use $ with sheet name
' query to find names that are not current sv buyers
' same rs will then be used to
' strSql = "SELECT DISTINCT [RLS BYR Name] AS NewName FROM
[tbl_imported_data$] "
' strSql = strSql & "WHERE [RLS BYR Name] NOT IN "
' strSql = strSql & "(SELECT [Buyers] FROM [Buyers and Codes$])"
'
' works
' strSql = "select distinct [RLS BYR] AS AllCodes FROM
[tbl_imported_data$] "
' strSql = strSql & " where [RLS BYR] NOT IN (select [codes] from
[Codes$])"
strSql = "select distinct [RLS BYR Name] AS Buyers FROM
[tbl_imported_data$] "
strSql = strSql & " where [RLS BYR Name] NOT IN (select [SVBuyers]
from [SV Buyers$])"
' fill recordset
rst.Open strSql, conn, adOpenKeyset, adLockOptimistic
Application.Cursor = xlWait
Application.StatusBar = "Getting Buyer names from tbl_imported_data
worksheet...Please wait"
lngRecCount = rst.RecordCount
Application.StatusBar = "Found " & CStr(lngRecCount) & " names NOT
listed in SVBuyers column"
rst.MoveFirst
If lngRecCount = 0 Then
MsgBox "No records found - Exiting"
rst.Close
Set rst = Nothing
If conn.State = adStateOpen Then
conn.Close
Set conn = Nothing
End If
Exit Sub
End If
' reset
Application.Cursor = xlDefault
' clone rs in order to use it against the Name column
Set rs_Clone = rst.Clone
rst.MoveFirst
' checking against namess to be filtered
strNewBuyers = CheckNamesColumn(rs_Clone, conn)
MsgBox "New names NOT currently in Buyers and Codes tab Name column
are: " & vbCrLf _
& strNewBuyers, vbOKOnly, "New Buyer Names"
' closing
rs_Clone.Close
Set rs_Clone = Nothing
rst.Close
Set rst = Nothing
If conn.State = adStateOpen Then
conn.Close
Set conn = Nothing
End If
End Sub
Private Function CheckNamesColumn(ByRef rsNames As ADODB.Recordset,
ByRef cnn As ADODB.Connection) As String
' purpose: Pass in recordset to check if name is also found in Name
colume
' which will be filtered out. If in Name column, delete
from rs.
' changing to open an rs on Name column of Buyers and Codes sheet
and loop
' using 2 recordsets and find meth rather than opening and closing
recordsets...
On Error Resume Next
Dim strSql As String
Dim x As Integer ' counter for rsnames
Dim strNewNames As String
Dim strOldNames As String
Dim lngNameCount As Integer
Dim rst As New ADODB.Recordset ' Name column of Buyers and Code
sheet
Dim strFind As String
Dim lngBuyers As Integer ' # records in rsNames
Dim intNewNames As Integer ' new names counter
strNewNames = ""
strOldNames = ""
strFind = ""
intNewNames = 0
lngBuyers = rsNames.RecordCount
rsNames.MoveFirst
' get recordset of names column used to autofilter
strSql = "SELECT [Name] FROM [Buyers and Codes$] Order by [Name] "
rst.Open strSql, cnn, adOpenKeyset, adLockOptimistic
lngNameCount = rst.RecordCount
rst.MoveFirst
Application.StatusBar = "Checking for new names..."
' loop thru rsnames if name not found add to strNewNames
With rsNames
For x = 1 To rsNames.RecordCount
strFind = !Buyers
' filter records for name - wonder if faster than find
With rst
.MoveFirst
.Filter = "Name = '" & strFind & "'"
If (.RecordCount = 0) Then
' new name
intNewNames = intNewNames + 1
Debug.Print "New: " & strFind
strNewNames = strNewNames & strFind & vbCrLf
End If
' removing filter same as using ""
.Filter = adFilterNone
End With ' rst
.MoveNext
Next
End With ' rsNames
MsgBox CStr(intNewNames) & " Names not in list: " & vbCrLf &
strNewNames
Application.StatusBar = ""
rst.Close
Set rst = Nothing
' return
CheckNamesColumn = strNewNames
End Function
Trying to get new names added to worksheet using following steps:
1. obtain list of buyer names from [RLS BYR Name] column that exists
in a worksheet (tbl_imported_data) and are not currently in [SVBuyers]
column of another worksheet (Buyers and Codes) in the same workbook
using an SQL Not In query.
2. Next is to check the above names against the [Name] column of
worksheet Buyers and Coders that is used to autofilter and
subsequently delete respective rows from worksheet tbl_imported_data
as part of a different method.
3. Finally, the remaining names will be displayed to user as new
buyer names for them to either add to the [SVBuyer] column or the
[Name] column.
Whew...
My problem is that I get no rows returned in the recordset from the
NOT IN SQL statement:
' [Buyers] is 2nd column in worksheet
strSql = "SELECT DISTINCT [RLS BYR Name] AS NewName FROM
[tbl_imported_data$] "
strSql = strSql & "WHERE [RLS BYR Name] NOT IN "
strSql = strSql & "(SELECT [Buyers] FROM [Buyers and Codes$])"
If I separate the statement into 2 select statements (one for
SVBuyers, one for distinct RLS Byr Name) I get 2 recordsets with rows.
As part of troubleshooting - don't recall why I tried this - I added
another sheet to which I copied the SVBuyers column as the only column
(leftmost column). I then ran the NOT IN query and this time it
returned records.
Is this correct or am I missing something? I've not come across
anything mentioning the need to use the first column position in a
worksheet for a SQL query. Currently using this workaround and am now
at step of displaying new names via UserForm vice current msgBox.
Thank you for your comments and suggestions,
Rey
****************************************************************************
Option Explicit
Sub GetNewBuyerNames()
' 1/11/2008, Rey Collazo
'purpose: access column/range in worksheet and
' display names not currently in buyers and codes sheet,
name column
' pseudo: open wrksheet, get range of current buyers, get unique
buyers from buyer name colu
' from worksheet, get not in current buyers names, display
to user
' then append to end of current buyer column and then run
filter macro
Dim thisWrkBook As Workbook
Dim buyerSheet As Worksheet
Dim rngCurrentBuyers As Range
Dim strNewNames As String
Dim arNewNames() As String 'array of new names
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strSql As String
Dim strConnection As String
Dim lngRecCount As Long
Dim x As Long
Dim rs_Clone As New ADODB.Recordset
Dim strNewBuyers As String
' test to get data from indiv columns
Dim rsSVBuyers As New ADODB.Recordset ' from svBuyers column of
Buyers and Codes sheet
Dim rsRLSByr As ADODB.Recordset ' from tbl_imported_data
sheet rls byr name column
Dim rst As New ADODB.Recordset
strNewNames = ""
strNewBuyers = ""
strConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=M:\Admin_Information
\tbl_imported_data_testing.xls;" & _
"Extended Properties=""Excel 8.0;"""
With conn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = strConnection
.CursorLocation = adUseClient ' needed else rs contains nothing
-1
.Open
End With
Application.DisplayStatusBar = True
' use $ with sheet name
' query to find names that are not current sv buyers
' same rs will then be used to
' strSql = "SELECT DISTINCT [RLS BYR Name] AS NewName FROM
[tbl_imported_data$] "
' strSql = strSql & "WHERE [RLS BYR Name] NOT IN "
' strSql = strSql & "(SELECT [Buyers] FROM [Buyers and Codes$])"
'
' works
' strSql = "select distinct [RLS BYR] AS AllCodes FROM
[tbl_imported_data$] "
' strSql = strSql & " where [RLS BYR] NOT IN (select [codes] from
[Codes$])"
strSql = "select distinct [RLS BYR Name] AS Buyers FROM
[tbl_imported_data$] "
strSql = strSql & " where [RLS BYR Name] NOT IN (select [SVBuyers]
from [SV Buyers$])"
' fill recordset
rst.Open strSql, conn, adOpenKeyset, adLockOptimistic
Application.Cursor = xlWait
Application.StatusBar = "Getting Buyer names from tbl_imported_data
worksheet...Please wait"
lngRecCount = rst.RecordCount
Application.StatusBar = "Found " & CStr(lngRecCount) & " names NOT
listed in SVBuyers column"
rst.MoveFirst
If lngRecCount = 0 Then
MsgBox "No records found - Exiting"
rst.Close
Set rst = Nothing
If conn.State = adStateOpen Then
conn.Close
Set conn = Nothing
End If
Exit Sub
End If
' reset
Application.Cursor = xlDefault
' clone rs in order to use it against the Name column
Set rs_Clone = rst.Clone
rst.MoveFirst
' checking against namess to be filtered
strNewBuyers = CheckNamesColumn(rs_Clone, conn)
MsgBox "New names NOT currently in Buyers and Codes tab Name column
are: " & vbCrLf _
& strNewBuyers, vbOKOnly, "New Buyer Names"
' closing
rs_Clone.Close
Set rs_Clone = Nothing
rst.Close
Set rst = Nothing
If conn.State = adStateOpen Then
conn.Close
Set conn = Nothing
End If
End Sub
Private Function CheckNamesColumn(ByRef rsNames As ADODB.Recordset,
ByRef cnn As ADODB.Connection) As String
' purpose: Pass in recordset to check if name is also found in Name
colume
' which will be filtered out. If in Name column, delete
from rs.
' changing to open an rs on Name column of Buyers and Codes sheet
and loop
' using 2 recordsets and find meth rather than opening and closing
recordsets...
On Error Resume Next
Dim strSql As String
Dim x As Integer ' counter for rsnames
Dim strNewNames As String
Dim strOldNames As String
Dim lngNameCount As Integer
Dim rst As New ADODB.Recordset ' Name column of Buyers and Code
sheet
Dim strFind As String
Dim lngBuyers As Integer ' # records in rsNames
Dim intNewNames As Integer ' new names counter
strNewNames = ""
strOldNames = ""
strFind = ""
intNewNames = 0
lngBuyers = rsNames.RecordCount
rsNames.MoveFirst
' get recordset of names column used to autofilter
strSql = "SELECT [Name] FROM [Buyers and Codes$] Order by [Name] "
rst.Open strSql, cnn, adOpenKeyset, adLockOptimistic
lngNameCount = rst.RecordCount
rst.MoveFirst
Application.StatusBar = "Checking for new names..."
' loop thru rsnames if name not found add to strNewNames
With rsNames
For x = 1 To rsNames.RecordCount
strFind = !Buyers
' filter records for name - wonder if faster than find
With rst
.MoveFirst
.Filter = "Name = '" & strFind & "'"
If (.RecordCount = 0) Then
' new name
intNewNames = intNewNames + 1
Debug.Print "New: " & strFind
strNewNames = strNewNames & strFind & vbCrLf
End If
' removing filter same as using ""
.Filter = adFilterNone
End With ' rst
.MoveNext
Next
End With ' rsNames
MsgBox CStr(intNewNames) & " Names not in list: " & vbCrLf &
strNewNames
Application.StatusBar = ""
rst.Close
Set rst = Nothing
' return
CheckNamesColumn = strNewNames
End Function