I have a table called contacts. That table has two columns i need to work with: company (company name) and location (county they are in). Location may have multiple values or not, it's filled by county names that separated by "; " I need to be able to run through these table records and do the following:
I've tried the below code (forgive me for any formatting errors), but what ends up happening is it repeats and fills a cell up to the max characters because if the location values aren't exactly the same, it just adds it to the end and sees its different when it hits again. After reflecting on this, I understand where the logic is failing but I am not sure at this point if I'm on the right path here or if I should scrap this and try a completely different way of doing this. Any help/examples of what might work here would be appreciated.
Private Sub Command14_Click()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim holdcomp As String
Dim holdloc As String
Dim holddep
holdcomp = ""
holdloc = ""
Set db = CurrentDb
Set rst = db.OpenRecordset("Contacts")
rst.MoveFirst
Do Until rst.EOF
If holdcomp = "" Then
holdcomp = rst!Company
End If
If holdloc = "" Then
holdloc = rst!Location
End If
If holdcomp = "" Then
holdcomp = rst!Company
End If
If holdcomp = rst!Company And holdloc = rst!Location Then
rst.MoveNext
End If
If holdcomp = rst!Company Then
If Not holdloc = rst!Location Then
rst.Edit
rst!Location = holdloc & "; " & rst!Location
rst.Update
holdloc = rst!Location
rst.MoveFirst
End If
End If
rst.MoveNext
Loop
End Sub
Consider this simple dataset:
ID | ContactName | CompanyName | Location |
---|---|---|---|
1 | a | x | l;m;p |
2 | b | y | p;q |
3 | c | z | l;r |
4 | d | x | h;j;l |
And procedure that will merge locations for each company without duplicates.
Sub LocationsCleanUp()
Dim db As DAO.Database
Dim rsCon As DAO.Recordset
Dim rsCom As DAO.Recordset
Dim colLoc As Collection
Dim aryLoc, x, strLoc
Set db = CurrentDb
Set rsCom = db.OpenRecordset("SELECT DISTINCT CompanyName FROM Contacts;")
Do While Not rsCom.EOF
Set rsCon = db.OpenRecordset("SELECT * FROM Contacts WHERE CompanyName='" & rsCom!CompanyName & "'")
Set colLoc = New Collection
Do While Not rsCon.EOF
aryLoc = Split(rsCon!Location, ";")
For Each x In aryLoc
On Error Resume Next
colLoc.Add x, x
Next
rsCon.MoveNext
Loop
'add code here to sort collection elements
strLoc = ""
For Each x In colLoc
strLoc = strLoc & x & ";"
Next
'do something with the new string - maybe an UPDATE sql action such as
'CurrentDb.Execute "UPDATE Contacts SET Location = '" & Left(strLoc, Len(strLoc) - 1) & _
' "' WHERE CompanyName='" & rsCom!CompanyName & "'"
Debug.Print rsCom!CompanyName, Left(strLoc, Len(strLoc) - 1)
rsCom.MoveNext
Loop
End Sub
On Error Resume Next
may not be best practice but it was expedient. Alternatively, have code that checks if item is already in collection. Here is one example from https://analystcave.com/vba-collection/ (which also uses Resume Next). I have seen more complex versions and seems error trapping or looping collection are the options.
Function CollectionContains(myCol As Collection, checkVal As Variant) As Boolean
On Error Resume Next
CollectionContains = False
Dim it As Variant
For Each it In myCol
If it = checkVal Then
CollectionContains = True
Exit Function
End If
Next
End Function
For sorting procedures, review How do I sort a collection?