my datatable is this:
and the table i need is :
i used a function to concatenate rows in ms access as follows:
Public Function GetList(SQL As String _
, Optional ColumnDelimeter As String = ", " _
, Optional RowDelimeter As String = vbCrLf) As String
'PURPOSE: to return a combined string from the passed query
'ARGS:
' 1. SQL is a valid Select statement
' 2. ColumnDelimiter is the character(s) that separate each column
' 3. RowDelimiter is the character(s) that separate each row
'RETURN VAL: Concatenated list
'DESIGN NOTES:
'EXAMPLE CALL: =GetList("Select Col1,Col2 From Table1 Where Table1.Key = " & OuterTable.Key)
Const PROCNAME = "GetList"
Const adClipString = 2
Dim oConn As ADODB.Connection
Dim oRS As ADODB.Recordset
Dim sResult As String
On Error GoTo ProcErr
Set oConn = CurrentProject.Connection
Set oRS = oConn.Execute(SQL)
sResult = oRS.GetString(adClipString, -1, ColumnDelimeter, RowDelimeter)
If Right(sResult, Len(RowDelimeter)) = RowDelimeter Then
sResult = Mid$(sResult, 1, Len(sResult) - Len(RowDelimeter))
End If
GetList = sResult
oRS.Close
oConn.Close
CleanUp:
Set oRS = Nothing
Set oConn = Nothing
Exit Function
ProcErr:
' insert error handler
Resume CleanUp
End Function
and the query i used is:
SELECT OB.Operation_Type, OB.Machine_Type, OB.Attatchment, GetList("Select Operation_Name From OB As T1 Where T1.Operation_Type = """ & [ob].[Operation_Type] & """ and T1.Machine_Type = """ & [ob].[Machine_Type] & """ and T1.Attatchment = """ & [ob].[Attatchment] & """ ",""," + ") AS Expr1
FROM ob
GROUP BY ob.Operation_Type, Machine_Type, Attatchment;
that is giving me result
i need sum of SAM of concatenated rows.
please help
Thank You
If SAM is a number field, you can simply add a SUM() aggregate. Unless I'm missing something.
SELECT OB.Operation_Type, OB.Machine_Type, OB.Attatchment,
GetList("Select Operation_Name From OB As T1 Where T1.Operation_Type = """ & [ob].[Operation_Type] & """ and T1.Machine_Type = """ & [ob].[Machine_Type] & """ and T1.Attatchment = """ & [ob].[Attatchment] & """ ",""," + ") AS Expr1,
SUM([SAM]) AS SumSAM
FROM ob
GROUP BY ob.Operation_Type, Machine_Type, Attatchment;
Related
I have been using below functions and i am trying to add one condition in the below function that is if Col"1" strings are not matched with Category strings then there are strings with the name of "Permanent" in the Col"1" so the function will go for the "Permanent" along with the Condition.
But now i have been receiving an compile error on the first line Set Result = RSToHtmlValues(Query.RS)
i do not know why the error is come any help will be appreciated.
'Return an HTMLValues object for matching record, else return Nothing
Private Function GetHtmlValues(Category As String, Permanent As String, Condition As String) As Htmlvalues
Dim Result As Htmlvalues
Dim TblHtmlValues As ListObject
Dim TableAddress As String
Dim strQuery As String
Dim Query As WbkQuery
TableAddress = ThisWorkbook.Sheets("Sheet1").ListObjects("Table4").Range.Address
TableAddress = Replace(TableAddress, "$", "")
Set Query = New WbkQuery
'Try the first query...
Query.ExecuteSql CategoryConditionSql(TableAddress, Category, Condition)
Set Result = RSToHtmlValues(Query.RS)
'If no result from first query then run the second using `Permanent`
If Result Is Nothing Then
Query.ExecuteSql CategoryConditionSql(TableAddress, Permanent, Condition)
Set Result = RSToHtmlValues(Query.RS)
End If
GetHtmlValues = Result
End Function
'Construct SQL for Category/Condition query
Function CategoryConditionSql(TableAddress As String, Category As String, Condition As String)
Dim strQuery As String
strQuery = "SELECT * FROM [" & LISTS_SHEET_NAME & "$" & TableAddress & "]" & _
" WHERE Category = '" & Category & "'" & _
" AND Condition = '" & Condition & "'"
End Function
'Return HTMLvalues object from RS (or nothing if RS has no records)
Function RSToHtmlValues(RS As Object) As Htmlvalues
Dim Result As Htmlvalues
If Not RS.EOF Then
Set Result = New Htmlvalues
Result.ConditionDescription = RecordsetHelpers.FieldToString(Query.RS.Fields("Condition Description"))
Result.Description1 = RecordsetHelpers.FieldToString(Query.RS.Fields("Description 1"))
Result.Description2 = RecordsetHelpers.FieldToString(Query.RS.Fields("Description 2"))
End If
Set RSToHtmlValues = Result
End Function
Since the RSToHtmlValues() function accepts only the RS property, you should access only this object, not the Query.
Just remove the Query qualifier:
'...
If Not RS.EOF Then
Set Result = New Htmlvalues
Result.ConditionDescription = RecordsetHelpers.FieldToString(RS.Fields("Condition Description"))
Result.Description1 = RecordsetHelpers.FieldToString(RS.Fields("Description 1"))
Result.Description2 = RecordsetHelpers.FieldToString(RS.Fields("Description 2"))
End If
'...
Update:
As discussed in the comments, HtmlValues is not an object. Trying to Set the reference as well as check for Nothing will generate errors.
Try the below. I had to change the RSToHtmlValues() function in order to be able to replace the statement:
If Result Is Nothing Then
Hope I didnt miss anything.
'Return an HTMLValues object for matching record, else return Nothing
Private Function GetHtmlValues(Category As String, Permanent As String, Condition As String) As HtmlValues
Dim Result As HtmlValues
Dim TblHtmlValues As ListObject
Dim TableAddress As String
Dim strQuery As String
Dim Query As WbkQuery
TableAddress = ThisWorkbook.Sheets("Sheet1").ListObjects("Table4").Range.Address
TableAddress = Replace(TableAddress, "$", "")
Set Query = New WbkQuery
'Try the first query...
Query.ExecuteSql CategoryConditionSql(TableAddress, Category, Condition)
'If no result from first query then run the second using `Permanent`
If Not TryRSToHtmlValues(Query.RS, Result) Then
Query.ExecuteSql CategoryConditionSql(TableAddress, Permanent, Condition)
TryRSToHtmlValues Query.RS, Result
End If
GetHtmlValues = Result
End Function
'Construct SQL for Category/Condition query
Function CategoryConditionSql(TableAddress As String, Category As String, Condition As String)
Dim strQuery As String
strQuery = "SELECT * FROM [" & LISTS_SHEET_NAME & "$" & TableAddress & "]" & _
" WHERE Category = '" & Category & "'" & _
" AND Condition = '" & Condition & "'"
End Function
'Fill HTMLvalues object from RS (or nothing if RS has no records) and report success/failure
Function TryRSToHtmlValues(ByVal RS As Object, ByRef webValues As HtmlValues) As Boolean
If RS.EOF Then Exit Function
webValues.ConditionDescription = RecordsetHelpers.FieldToString(RS.Fields("Condition Description"))
webValues.Description1 = RecordsetHelpers.FieldToString(RS.Fields("Description 1"))
webValues.Description2 = RecordsetHelpers.FieldToString(RS.Fields("Description 2"))
TryRSToHtmlValues = True
End Function
I am trying to create a dynamic SQL string builder for my application and am having some issues with encapsulating the fieldnames with brackets.
My code is as follows:
Public Sub BuildDynamicSQL( _
FieldsArray() As String, _
ByVal TableName As String)
' Declarations ->
Dim strSQL As String: strSQL = vbNullString
Dim Field As Variant
Dim i As Integer: i = 0
' Validate fields array ->
If IsEmpty(FieldsArray) Then Exit Sub
' Construct SQL using Fields array ->
strSQL = "SELECT "
For Each Field In FieldsArray
If i = 0 Then
strSQL = strSQL + "[" + Field + "]"
Else
strSQL = strSQL + "," + "[" + Field + "]"
End If
i = i + 1
Next
strSQL = strSQL + " FROM " + TableName
End Sub
When I run this code with more than one field in my FieldsArray, I keep getting the following output with unnecessary leading spaces.
SELECT [log_id],[ log_description],[ create_user],[ create_date_time] FROM activity_log
Has anyone got any idea how I can get this to work as expected?
Many thanks.
Here is a generalized example of a function accepting a paramarray argument and returning a string.
Option Explicit
Sub main()
Dim sql As String
sql = buildMySql("mytable")
Debug.Print sql
sql = buildMySql("mytable", "fld1", "fld2", "fld3", "fld4")
Debug.Print sql
End Sub
Function buildMySql(tbl As String, ParamArray flds()) As String
Dim str As String, f As Long
If IsMissing(flds) Then
str = "select * from [" & tbl & "];"
Else
str = "select "
For f = LBound(flds) To UBound(flds)
str = str & "[" & flds(f) & "]" & IIf(f < UBound(flds), Chr(44), vbNullString)
Next f
str = str & " from [" & tbl & "];"
End If
buildMySql = str
End Function
'results
select * from [mytable];
select [fld1],[fld2],[fld3],[fld4] from [mytable];
In Access 2016 I'm trying to open a recordset and save data from it in other variables, but I keep getting this error.
The program itself has more parts, but I only get error in this one, it just update data on its database.
This is my code:
Option Compare Database
Option Explicit
Private Sub btnValidateTimesheet_Click()
' Update timesheet to "Justificat"
Dim intIdTimesheet As Integer
If IsNull(cmbDraftTimesheets.Value) Then
MsgBox("You have to select a timesheet that is Borrador")
Exit Sub
End If
intIdTimesheet = cmbDraftTimesheets.Column(0)
DoCmd.SetWarnings False
DoCmd.RunSQL "update Timesheets set estat = ""Justificat"" where id=" & intIdTimesheet
DoCmd.SetWarnings True
End Sub
Private Sub btnValidateTimesheetLines_Click()
' We select the timesheet_lines for employee, project, activity and dates selected
' For each justification, a new "Justificat" Timesheet is generated which hang timesheet_lines
' ------------------------------- Variables -------------------------------
Dim dictTsLines As Object
Set dictTsLines = CreateObject("Scripting.Dictionary")
' Form inputs
Dim intCodTreb As Integer
Dim strCodProj As String
Dim dateInici, dateFi As Date
Dim intExercici As Integer
' Query strings
Dim strSQLFrom, strSQLWhere As String
Dim strSQLCount, strSQLJustAct, strSQLTsLines As String
' Recordsets
Dim rsCount, rsJustAct, rsTimesheets, rsTsLines As Recordset
' Aux and others...
Dim continue As Integer
Dim intIdJustificacio, intIdTs As Integer
Dim strActivitat As String
' --------------------------------------- Main ---------------------------------------------
' Taking form data
intCodTreb = cmbTreballador.Column(0)
strCodProj = cmbProjecte.Column(1)
dateInici = txtDataInici.Value
dateFi = txtDataFi.Value
' We check the dates are correct
If IsNull(dateInici) Or IsNull(dateFi) Then
MsgBox("Dates can't be null")
Exit Sub
End If
If dateFi < dateInici Then
MsgBox("Start date must be earlier or the same as final date")
Exit Sub
End If
If year(dateInici) <> year(dateFi) Then
MsgBox("Dates must be in the same year")
Exit Sub
End If
intExercici = year(dateInici)
' Make of the clause FROM and WHERE of the select query of timesheet_lines
strSQLFrom = " from (timesheet_lines tsl " & _
" left join timesheets ts on tsl.timesheet_id = ts.id) " & _
" left join justificacions j on j.id = ts.id_justificacio "
strSQLWhere = " where ts.estat = ""Borrador"" " & _
" and tsl.data >= #" & Format(dateInici, "yyyy/mm/dd") & "# " & _
" and tsl.data <= #" & Format(dateFi, "yyyy/mm/dd") & "# "
If Not IsNull(intCodTreb) Then
strSQLWhere = strSQLWhere & " and tsl.cod_treb = " & intCodTreb
End If
If Not IsNull(strCodProj) Then
strSQLWhere = strSQLWhere & " and j.cod_proj=""" & strCodProj & """ "
End If
' Alert how much timesheet_lines are going to be validated
strSQLCount = "select count(*) " & strSQLFrom & strSQLWhere
Set rsCount = CurrentDb.OpenRecordset(strSQLCount)
Continue Do = MsgBox( rsCount(0) & " registries are going to be validated" & vbNewLine & _
"Do you want to continue?", vbOKCancel)
If continue <> 1 Then
Exit Sub
End If
' We select the tuples Justificacio, Activitat of timesheet_lines selected
strSQLJustAct = "select distinct ts.id_justificacio " & strSQLFrom & strSQLWhere
Set rsJustAct = CurrentDb.OpenRecordset(strSQLJustAct)
Set rsTimesheets = CurrentDb.OpenRecordset("Timesheets")
' A new timesheet is generated for each tupla
Do While Not rsJustAct.EOF
intIdJustificacio = rsJustAct(0)
strActivitat = rsJustAct(1)
rsTimesheets.AddNew
rsTimesheets!data_generacio = Now()
rsTimesheets!estat = "Justificat"
rsTimesheets!Id_justificacio = intIdJustificacio
rsTimesheets!activitat = strActivitat
rsTimesheets!data_inici = dateInici
rsTimesheets!data_fi = dateFi
rsTimesheets!exercici = intExercici
intIdTs = rsTimesheets!Id
rsTimesheets.Update
' We save the related id of the selected timesheet in a dictionary
dictTsLines.Add intIdJustificacio & "_" & strActivitat, intIdTs
rsJustAct.MoveNext
Loop
' We select all the affected timesheet_lines and we update the related timesheet using the dictionary
strSQLTsLines = "select tsl.id, tsl.timesheet_id, ts.id_justificacio, ts.activitat " & strSQLFrom & strSQLWhere
Set rsTsLines = CurrentDb.OpenRecordset(strSQLTsLines)
With rsTsLines
Do While Not .EOF
.EDIT
intIdJustificacio = !Id_justificacio
strActivitat = !activitat
!timesheet_id = dictTsLines.Item(intIdJustificacio & "_" & strActivitat)
.Update
.MoveNext
Loop
End With
rsTimesheets.Close
Set rsCount = Nothing
Set rsJustAct = Nothing
Set rsTimesheets = Nothing
Set rsTsLines = Nothing
End Sub
Debugger: The error is coming up at the line:
strActivitat = rsJustAct(1)
I checked that the data the recordset is saving exists and it does.
Your recordset contains just one column ("select distinct ts.id_justificacio"), but you are trying to read second column strActivitat = rsJustAct(1)
Add requred column to recordset.
I like to export data (single records) from one Access database to another one in another country. The idea is that I want to send a text file with INSERT INTO statements per email and the receiving PC just executes these INSERT INTO statements. I wrote already the code to read and execute the INSERT INTO statements in these text files.
Obviously I have to generate the INSERT INTO statements.
Here is an example.
I have the following table:
Table1
Id number
PersonName text
DoB date, can be empty
NumberOfChildern number, can be empty
I select the data like this:
SELECT Id, PersonName, DoB, NumberOfChildern FROM Table1;
What I want to generate are statements like this:
INSERT INTO Table1 (Id, PersonName, DoB, NumberOfChildern ) VALUES (1, ‘Peter’, #5-17-1990#, 1)
If all fields are always filled in then I could write one time the code and that's it. But there is a problem if a couple of fields might contain data or maybe no data.
Here are some similar but different versions of the above statement:
INSERT INTO Table1 (Id, PersonName, DoB, NumberOfChildern ) VALUES (1, ‘Peter’, #5-17-1990#, 1)
INSERT INTO Table1 (Id, PersonName, NumberOfChildern ) VALUES (1, ‘Peter’, 1)
INSERT INTO Table1 (Id, PersonName, DoB ) VALUES (1, ‘Peter’, #5-17-1990#)
INSERT INTO Table1 (Id, PersonName ) VALUES (1, ‘Peter’)
With just two fields which can contain NULL values there are already 4 different versions of this statement and with more fields it becomes more and more complicated (not really complicated but more work).
I think about writing code in VBA which analyzes the table and the records which I want to export to check which kind of fields are used (i.e. date) and then generate statements like above.
I am sure I can do this but I wonder if maybe others did this before.
I don't want to reinvent the wheel.
But searching for "generate SQL insert statements" is not really efficient.
Any ideas?
It's your lucky day. I have done this for SQL Server - with a few modifications done below it should work for Access SQL.
The key is to insert VALUES NULL, not create different statements if values are null.
The SET IDENTITY_INSERT ON/OFF probably isn't needed for Access.
Gustav has posted a generic function that can replace all Sqlify/SqlDate etc. helper functions and covers more data types.
Public Sub InsertStatementsSql(ByVal sTABLE As String)
Dim DB As DAO.Database
Dim TD As DAO.TableDef
Dim RS As DAO.Recordset
Dim fld As DAO.Field
Dim sKpl As String
Dim sStart As String
Dim sValues As String
Dim S As String
Dim v As Variant
Dim i As Long
Dim bIdentity As Boolean
Set DB = CurrentDb
Set TD = DB.TableDefs(sTABLE)
Set RS = DB.OpenRecordset(sTABLE, dbOpenSnapshot)
' Check for Autonumber/IDENTITY column
bIdentity = False
For i = 0 To TD.Fields.count - 1
If (TD.Fields(i).Attributes And dbAutoIncrField) > 0 Then
bIdentity = True
Exit For
End If
Next i
If bIdentity Then
sKpl = sKpl & "SET IDENTITY_INSERT " & sTABLE & " ON;" & vbCrLf & vbCrLf
End If
' "INSERT INTO ... VALUES " for every line
For i = 0 To TD.Fields.count - 1
sStart = StrAppend(sStart, TD.Fields(i).Name, ", ")
Next i
sStart = "INSERT INTO " & sTABLE & " (" & sStart & ") VALUES "
' One line per record
Do While Not RS.EOF
sValues = ""
For i = 0 To TD.Fields.count - 1
v = RS(i)
If IsNull(v) Then
S = "NULL"
Else
Set fld = TD.Fields(i)
Select Case fld.Type
Case dbText, dbMemo: S = Sqlify(CStr(v))
Case dbDate: S = SqlDate(CDate(v))
Case dbDouble, dbSingle: S = SqlNumber(CDbl(v))
Case Else: S = CStr(v)
End Select
End If
sValues = StrAppend(sValues, S, ", ")
Next i
' Append line to full SQL
sKpl = sKpl & vbCrLf & sStart & " (" & sValues & ");"
RS.MoveNext
Loop
RS.Close
Set TD = Nothing
If bIdentity Then
sKpl = sKpl & vbCrLf & vbCrLf & "SET IDENTITY_INSERT " & sTABLE & " OFF;" & vbCrLf
End If
Debug.Print sKpl
' see https://support.microsoft.com/en-us/kb/210216 or https://msdn.microsoft.com/en-us/library/office/ff192913.aspx
' or https://stackoverflow.com/a/25431633/3820271
'ClipBoard_SetData sKpl
End Sub
' ------------------- helper functions -----------------
' ein'string --> 'ein''string'
Public Function Sqlify(ByVal S As String) As String
S = Replace(S, "'", "''")
S = "'" & S & "'"
Sqlify = S
End Function
Public Function SqlDate(vDate As Date) As String
SqlDate = "#" & Format(vDate, "yyyy-mm-dd") & "#"
End Function
Public Function SqlNumber(num As Double) As String
SqlNumber = Replace(CStr(num), ",", ".")
End Function
Public Function StrAppend(sBase As String, sAppend As Variant, sSeparator As String) As String
If Len(sAppend) > 0 Then
If sBase = "" Then
StrAppend = Nz(sAppend, "")
Else
StrAppend = sBase & sSeparator & Nz(sAppend, "")
End If
Else
StrAppend = sBase
End If
End Function
I have a field called "sku" which uniquely identifies products on the table, there are about 38k products. I have a "sku generator" which uses other fields in the table to create the SKU. It's worked perfectly without an issue until I started producing SKUs for a large amount of products. I would launch the generator and it would stop around 15,000 and say "System Resource exceeded" and highlight the following code in the function:
Found = IsNull(DLookup("sku", "Loadsheet", "[sku]='" & TempSKU & "'"))
I didn't have time to fully fix the issue, so a temporary fix for me was to split the database in two, and run the sku generator seperately on both files. Now that I have more time I want to investigate why exactly it gets stuck around this number, and if there's a possibility of fixing this issue (it would save some time with splitting files and then grouping them again). I also have an issue with it getting really slow at times, but I think it's because it's processing so much when it runs. Here is the function
Option Compare Database
Private Sub Command2_Click() 'Generate SKU
Command2.Enabled = False: Command3.Enabled = False: Command2.Caption = "Generating ..."
Me.RecordSource = ""
CurrentDb.QueryDefs("ResetSKU").Execute
Me.RecordSource = "loadsheet_4"
Dim rs As Recordset, i As Long
Set rs = Me.Recordset
rs.MoveLast: rs.MoveFirst
For i = 0 To rs.RecordCount - 1
rs.AbsolutePosition = i
rs.Edit
rs.Fields("sku") = SetSKU(rs)
rs.Update
DoEvents
Next
Command2.Enabled = True: Command3.Enabled = True: Command2.Caption = "Generate SKU"
End Sub
Public Function SetSKU(rs As Recordset) As String
Dim TempStr As String, TempSKU As String, id As Integer, Found As Boolean, ColorFound As Variant
id = 1: ColorFound = DLookup("Abbreviated", "ProductColors", "[Color]='" & rs.Fields("single_color_name") & "'")
TempStr = "ORL-" & UCase(Left(rs.Fields("make"), 2)) & "-"
TempStr = TempStr & Get1stLetters(rs.Fields("model"), True) & rs.Fields("year_dash") & "-L-"
TempStr = TempStr & "WR-"
TempStr = TempStr & IIf(IsNull(ColorFound), "?", ColorFound) & "-4215-2-"
TempStr = TempStr & rs.Fields("color_code")
TempSKU = Replace(TempStr, "-L-", "-" & ADDZeros(id, 2) & "-L-")
Found = IsNull(DLookup("sku", "Loadsheet", "[sku]='" & TempSKU & "'"))
While Found = False
id = id + 1
TempSKU = Replace(TempStr, "-L-", "-" & ADDZeros(id, 2) & "-L-")
Found = IsNull(DLookup("sku", "Loadsheet", "[sku]='" & TempSKU & "'"))
Wend
If id > 1 Then
' MsgBox TempSKU
End If
SetSKU = TempSKU
End Function
Public Function Get1stLetters(Mystr As String, Optional twoLetters As Boolean = False) As String
Dim i As Integer
Get1stLetters = ""
For i = 0 To UBound(Split(Mystr, " ")) 'ubound gets the number of the elements
If i = 0 And twoLetters Then
Get1stLetters = Get1stLetters & UCase(Left(Split(Mystr, " ")(i), 2))
GoTo continueFor
End If
Get1stLetters = Get1stLetters & UCase(Left(Split(Mystr, " ")(i), 1))
continueFor:
Next
End Function
Public Function ADDZeros(N As Integer, MAX As Integer) As String
Dim NL As Integer
NL = Len(CStr(N))
If NL < MAX Then
ADDZeros = "0" & N 'StrDup(MAX - NL, "0") & N
Else: ADDZeros = N
End If
End Function
Notes: This function also calls other functions as well that adds a unique identifier to the SKU and also outputs the first letter of each word of the product
Also I'm running on 64 bit access.
If you require any other info let me know, I didn't post the other functions but if needed let me know.
thanks.
I am not 100% sure how you have split the Database into two files and that you are running the generator on both files. However I have a few suggestion to the function you are using.
I would not pass the recordset object to this function. I would rather pass the ID or unique identifier, and generate the recordset in the function. This could be a good start for efficiency.
Next, declare all objects explicitly, to avoid library ambiguity. rs As DAO.Recordset. Try to make use of inbuilt functions, like Nz().
Could Get1stLetters method be replaced with a simple Left() function? How about ADDZeros method?
Using DLookup might be a bit messy, how about a DCount instead? Could the following be any use now?
Public Function SetSKU(unqID As Long) As String
Dim TempStr As String, TempSKU As String
Dim id As Integer
Dim ColorFound As String
Dim rs As DAO.Recordset
id = 1
Set rs = CurrentDB.OpenRecordset("SELECT single_color_name, make, model, year_dash, color_code " & _
"FROM yourTableName WHERE uniqueColumn = " & unqID)
ColorFound = Nz(DLookup("Abbreviated", "ProductColors", "[Color]='" & rs.Fields("single_color_name") & "'"), "?")
TempStr = "ORL-" & UCase(Left(rs.Fields("make"), 2)) & "-"
TempStr = TempStr & Get1stLetters(rs.Fields("model"), True) & rs.Fields("year_dash") & "-L-"
TempStr = TempStr & "WR-"
TempStr = TempStr & ColorFound & "-4215-2-"
TempStr = TempStr & rs.Fields("color_code")
TempSKU = Replace(TempStr, "-L-", "-" & ADDZeros(id, 2) & "-L-")
While DCount("*", "Loadsheet", "[sku]='" & TempSKU & "'") <> 0
id = id + 1
TempSKU = Replace(TempStr, "-L-", "-" & ADDZeros(id, 2) & "-L-")
Wend
If id > 1 Then
'MsgBox TempSKU'
End If
Set rs = Nothing
SetSKU = TempSKU
End Function