Private Sub test()
Dim rs As DAO.recordSet
Dim db As DAO.Database
Dim i As Long
Dim s As String
set db=Currentdb
Set rs = db.OpenRecordset("select [name], [weight (kg)] from table1 order by 2;", dbOpenSnapshot)
With rs
If Not (.BOF And .EOF) Then .MoveFirst
Do While Not .EOF
s = ![name] & " - " & ![weight (kg)]
.MoveNext
If Not .EOF Then s = s & " and " & ![name] & " - " & ![weight (kg)]
db.execute ("Insert Into table2 ([Nearest Weight]) SELECT '" & s & "';")
If .EOF Then Exit Do
.MoveNext
Loop
.Close
End With
Set rs = Nothing
Set db = Nothing
End Sub
If you added:-
Name .......... weight
jjj ..................... 15
What would Table 2 look like?
Sent from my SM-G925F using Tapatalk
CurrentDb.Execute "DELETE * FROM table2" 'Clear contents of table2
follow up question.. in my table there is duplicate data under the field [name], but i don't want to match them even they have the same or nearest weight value. What should i add to arnelgp's code?
I don't understand what you want. If there's a duplicate name that name should be thrown out all together? I'd like to see an example of what you mean, i.e., input data with duplicate and the desired output.
Private Sub test()
Dim rs As DAO.Recordset
Dim db As DAO.Database
Dim arr() As Long
Dim i As Long
Dim s As String
Dim strName As String
Dim dblWeight As Double
Set db = CurrentDb
Dim bm As Variant
Set rs = db.OpenRecordset("select [id], [name], [weight (kg)] from table1 order by 3;", dbOpenSnapshot)
With rs
ReDim arr(0)
arr(0) = -1
If Not (.BOF And .EOF) Then .MoveFirst
Do While Not .EOF
If Not InArray(!id, arr) Then
strName = ![Name]
dblWeight = ![weight (kg)]
s = ![Name] & " - " & ![weight (kg)]
bm = .Bookmark
ReDim Preserve arr(UBound(arr) + 1)
arr(UBound(arr)) = !id
Do While Not .EOF
.MoveNext
If Not .EOF Then
If strName <> !Name And Not InArray(!id, arr) Then
s = s & " and " & ![Name] & " - " & ![weight (kg)]
ReDim Preserve arr(UBound(arr) + 1)
arr(UBound(arr)) = !id
Exit Do
End If
End If
Loop
db.Execute ("Insert Into table2 ([Nearest Weight]) SELECT '" & s & "';")
.Bookmark = bm
End If
.MoveNext
Loop
.Close
End With
Set rs = Nothing
Set db = Nothing
End Sub
Private Function InArray(value As Long, aray As Variant) As Boolean
Dim i As Long
For i = LBound(aray) To UBound(aray)
If value = aray(i) Then
InArray = True
Exit For
End If
Next
End Function
walang anuman po!