Updating access records

Question

I spent an hour or so this morning compiling this, and since I have started reading Clean Code and The Pragmatic Programmer I figured I would let you help me get slightly better at this.

Due to some crappy limitations with the specifics I was forced to work in Excel VBA instead of Access (someone doesn't want to build tables for the two lists in the Excel sheet).

The code pulls a list of defects from a production table, checks a master list to see if it ever existed, then checks an open list to see if it's current and updates the table accordingly. This could be super easy and potentially 100% automated if they would make tables for the two lists. The log of what was found per defect# (writing to sheet) is something I added just in case they want a log.

Private Sub thisbetheshitmane()
 Dim db As DAO.Database
 Dim rst As DAO.Recordset
 Dim vAr As String
 Dim i As Integer
 Dim y As Integer
 Dim InCombined As Boolean
 Dim InOpen As Boolean
 Set db = DBEngine.OpenDatabase("C:\Users\dzcoats\Documents\Microsoft.accdb")
 Set rst = db.OpenRecordset("SELECT DISTINCT [VDefects].Defect FROM [VDefects] WHERE [VDefects].Defect IS NOT NULL;")
 Dim QResult() As Variant
 QResult = rst.GetRows(rst.RecordCount)
 For a = LBound(QResult, 2) To UBound(QResult, 2)
 vAr = QResult(0, a)
 Debug.Print ; vAr
 Next a
 Dim CombinedList() As Variant
 CombinedList = Application.Transpose(Worksheets(1).Range("b2:b2000").Value)
 Dim OpenList() As Variant
 OpenList = Application.Transpose(Worksheets(1).Range("a2:a2000").Value)
 For y = LBound(QResult, 2) To UBound(QResult, 2)
 vAr = Trim(QResult(0, y))
 InCombined = False
 For a = LBound(CombinedList) To UBound(CombinedList)
 If vAr = CombinedList(a) Then InCombined = True
 Next a
 InOpen = False
 For a = LBound(OpenList) To UBound(OpenList)
 If vAr = OpenList(a) Then InOpen = True
 Next a
 If vAr <> "Defect" And vAr <> vbNullString And vAr <> "" Then
 If InCombined = False And InOpen = False Then
 set rst = db.OpenRecordSet ("UPDATE [VDefects] SET [VDefects].Status ='Bad Defect Number' WHERE ((([VDefect].Defect)='"& vAr &"'));")
 Debug.Print "BAD "; vAr
 ThisWorkbook.Sheets("Sheet2").Cells(Sheet2.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = "Bad"
 ThisWorkbook.Sheets("Sheet2").Cells(Sheet2.Rows.Count, 1).End(xlUp).Offset(0, 1).Value = vAr
 End If
 If InCombined = True And InOpen = False Then
 set rst = db.OpenRecordSet ("UPDATE [VDefects] SET [VDefects].Status ='Completed' WHERE ((([VDefects].Defect)='"& vAr &"'));")
 Debug.Print "CLOSED "; vAr
 ThisWorkbook.Sheets("Sheet2").Cells(Sheet2.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = "Closed"
 ThisWorkbook.Sheets("Sheet2").Cells(Sheet2.Rows.Count, 1).End(xlUp).Offset(0, 1).Value = vAr
 End If
 If InCombined = True And InOpen = True Then
 Debug.Print "OPEN "; vAr
 ThisWorkbook.Sheets("Sheet2").Cells(Sheet2.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = "Open"
 ThisWorkbook.Sheets("Sheet2").Cells(Sheet2.Rows.Count, 1).End(xlUp).Offset(0, 1).Value = vAr
 End If
 End If
 Next y
 rst.Close
 Set rs = Nothing
 db.Close
 Set db = Nothing
End Sub

• user109261: I updated my answer to show how you can use the values in your Open and Combined lists in the query. In this way, the query will do all the work.

Answer 1

Here is the code refined using these features:

• rst.Filter
• rst.Update
• Scripting.Dictionary
• Range("A1").CopyFromRecordset rst

---

Sub ThisBeTheShitMane()
 Const DBPath = "C:\Users\dzcoats\Documents\Microsoft.accdb"
 Const DebugMode As Boolean = False
 Dim db As DAO.Database
 Dim rst As DAO.Recordset
 Dim key As String
 Dim vAr
 Dim d As Object: Set d = CreateObject("Scripting.Dictionary")
 Set db = DBEngine.OpenDatabase(DBPath)
 Set rst = db.OpenRecordSet("SELECT [VDefects].Defect, [VDefects].Status FROM [VDefects] WHERE [VDefects].Defect IS NOT NULL;")
 'Combined List
 With Worksheets(1)
 For Each vAr In .Range("B2", .Range("B" & .Rows.Count).End(xlUp)).Value
 key = vAr
 d(key) = "Completed"
 Next
 End With
 'Open List
 With Worksheets(1)
 For Each vAr In .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Value
 key = vAr
 If d.Exists(key) Then
 d(key) = "OPEN"
 Else
 If DebugMode Then Debug.Print "vAr: "; vAr, "ID is in the Open List but is missing from the Combined List "
 End If
 Next
 End With
 With rst
 .MoveFirst
 Do Until .EOF
 key = ![Defect]
 .Edit
 ![Status] = IIf(d.Exists(key), d(key), "Bad Defect Number")
 .Update
 .MoveNext
 Loop
 .MoveFirst
 End With
 Worksheets("Sheet2").Range("A1").CopyFromRecordset rst
 rst.Close
 Set rst = Nothing
 db.Close
 Set db = Nothing
End Sub

But we could just let the database do the work for us by converting the Open and Combined list into a comma separated values list and using IN() to check the values. If [Defect] is a text field you will has to wrap the values in quotes.

Sample Query:

UPDATE VDefects SET VDefects.Status = IIf([VDefects]![Defect] NOT IN (1,2,3,4,5,6) And [VDefects]![Defect] NOT IN (4,5,6,7,8,9),'Bad Defect Number',IIf([VDefects]![Defect] NOT IN (1,2,3,4,5,6),'Completed','OPEN'));

---

Sub JustDoIt()
 Const DBPath = "C:\Users\best buy\Desktop\Microsoft.accdb"
 Dim db As DAO.Database: Set db = DBEngine.OpenDatabase(DBPath, , True)
 Dim rst As DAO.Recordset
 Dim sSQL As String, t1 As String, t2 As String
 Dim arr1 As Variant, arr2 As Variant
 With Sheet1
 t1 = getValueList(.Range("A2", .Range("A" & rows.Count).End(xlUp)), False)
 t2 = getValueList(.Range("B2", .Range("B" & rows.Count).End(xlUp)), False)
 End With
 sSQL = "UPDATE VDefects SET VDefects.Status = IIf([VDefects]![Defect] NOT IN (" & t1 & ") And [VDefects]![Defect] NOT IN (" & t2 & "),'Bad Defect Number',IIf([VDefects]![Defect] NOT IN (" & t1 & "),'Completed','OPEN'));"
 db.Execute sSQL
 Set rst = db.OpenRecordSet("SELECT [VDefects].Defect, [VDefects].Status FROM [VDefects] WHERE [VDefects].Defect IS NOT NULL;")
 Worksheets("Sheet2").Range("A1").CopyFromRecordset rst
 rst.Close
 Set rst = Nothing
 db.Close
 Set db = Nothing
End Sub
Function getValueList(Target As Range, WrapInQuotes) As String
 Dim arr As Variant
 arr = Application.TRanspose(Target.Value)
 If WrapInQuotes Then
 getValueList = Join(arr, """,""") & """"
 Else
 getValueList = Join(arr, ",")
 End If
End Function

---

Answer 2

I also added this to help with in the event non numerics are falsley entered in the UI that inputs data into the DB (again another reason why I wish they'd implement new tables and better db design lol)

 If Not IsNumeric(vAr) Then
 InCombined = True
 InOpen = True
 Else
 InCombined = IsError(Application.Match(CLng(vAr), vArray, 0))
 InOpen = IsError(Application.Match(CLng(vAr), vArray2, 0))
 End If

after some prelim testing- this removes the need for either loop seeing in how everything is a number but stored into the table as text (eye roll)