I created a table where you can store the languages, and you will need to update this table when a new language is added. I put a Count field in this table to use to hold your counts as we loop through the records.
Based on the tbl_Original with your sample data, I was able to get this to work using this code:
'================================================= ===
'Turn off Query Warnings
DoCmd.SetWarnings False
'Clean out old data
DoCmd.OpenQuery "qryDELETE_MasterLang"
'Append Unique Area Values
DoCmd.OpenQuery "qryAPPEND_Areas"
'Turn on Query Warnings
DoCmd.SetWarnings True
Dim rs As ADODB.Recordset
Dim rsLang As ADODB.Recordset
Dim rsWrite As ADODB.Recordset
Dim sSQL As String
Dim sLang As String
Dim sWrite As String
Dim lArea As Long
Dim sLang1 As Variant
Dim sLang2 As Variant
Dim sLang3 As Variant
Dim sLang4 As Variant
Dim sLang5 As Variant
Dim sLang6 As Variant
Dim sLang7 As Variant
Dim sFinalString As String
'Open the Language table
sLang = "SELECT * FROM tbl_Language" 'for Select Case loop
Set rsLang = New ADODB.Recordset
rsLang.Open sLang, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
'Open outer loop = Each Individual Area
sWrite = "SELECT * FROM tbl_MasterLang"
Set rsWrite = New ADODB.Recordset
rsWrite.Open sWrite, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
rsWrite.MoveFirst
Do Until rsWrite.EOF
'Take first Area number
lArea = rsWrite("Area")
'Now open Original where Area = lArea
sSQL = "SELECT * FROM tbl_Original WHERE [Area] = " & lArea
Set rs = New ADODB.Recordset
rs.Open sSQL, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
'Clear out count in tbl_Language
DoCmd.SetWarnings False
DoCmd.OpenQuery "qryUPDATE_LangCount"
DoCmd.SetWarnings True
rs.MoveFirst
Do Until rs.EOF
sLang1 = rs("Lang1")
sLang2 = rs("Lang2")
sLang3 = rs("Lang3")
sLang4 = rs("Lang4")
sLang5 = rs("Lang5")
sLang6 = rs("Lang6")
sLang7 = rs("Lang7")
rsLang.MoveFirst
Do Until rsLang.EOF
If sLang1 = rsLang("Language") Then
rsLang("lCount") = rsLang("lCount") + 1
End If
If sLang2 = rsLang("Language") Then
rsLang("lCount") = rsLang("lCount") + 1
End If
If sLang3 = rsLang("Language") Then
rsLang("lCount") = rsLang("lCount") + 1
End If
If sLang4 = rsLang("Language") Then
rsLang("lCount") = rsLang("lCount") + 1
End If
If sLang5 = rsLang("Language") Then
rsLang("lCount") = rsLang("lCount") + 1
End If
If sLang6 = rsLang("Language") Then
rsLang("lCount") = rsLang("lCount") + 1
End If
If sLang7 = rsLang("Language") Then
rsLang("lCount") = rsLang("lCount") + 1
End If
rsLang.MoveNext
Loop
rs.MoveNext
Loop
'Build string from tbl_Language where lcount is greater than 1
rsLang.MoveFirst
Do Until rsLang.EOF
If rsLang("lCount") > 1 Then
sFinalString = sFinalString & rsLang("Language") & "; "
End If
rsLang.MoveNext
Loop
'Remove last two characters
sFinalString = Left(sFinalString, (Len(sFinalString) - 2))
'Update Table
rsWrite("Lang") = sFinalString
rsWrite.Update
sFinalString = ""
rsWrite.MoveNext
Loop
rsWrite.Close
'================================================= ===
This is a little more elegant than originally suggested. You must maintaint the Language table, though.
mmcdonal
Look it up at:
http://wrox.books24x7.com
