VB Code to merge records by groups

S

SKV

Active Member
Joined
Jan 7, 2009
Messages
257
I am very basic in VB coding so appreciate if you can provide more details

I have a table with records with a group ID. So a group ID can have more than 1 records. I want to merge these records in 1 row such that other values of the records are combined in one row only.

Example of table T1
<TABLE style="WIDTH: 192pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=256><COLGROUP><COL style="WIDTH: 48pt" span=4 width=64><TBODY><TR style="HEIGHT: 14.4pt" height=19><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 48pt; HEIGHT: 14.4pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 height=19 width=64>Group ID</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 width=64>Val1</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 width=64>Val2</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 width=64>Val3</TD></TR><TR style="HEIGHT: 14.4pt" height=19><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 14.4pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66 height=19>1</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66>a</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66>x</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66>2</TD></TR><TR style="HEIGHT: 14.4pt" height=19><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 14.4pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66 height=19>1</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66>b</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66>y</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66>2</TD></TR><TR style="HEIGHT: 14.4pt" height=19><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 14.4pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66 height=19>1</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66>c</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66>2</TD></TR><TR style="HEIGHT: 14.4pt" height=19><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 14.4pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66 height=19>2</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66>f</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66>w</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66>3</TD></TR></TBODY></TABLE>


Want to create a new table T2
<TABLE style="WIDTH: 192pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=256><COLGROUP><COL style="WIDTH: 48pt" span=4 width=64><TBODY><TR style="HEIGHT: 14.4pt" height=19><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 48pt; HEIGHT: 14.4pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 height=19 width=64>Group ID</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 width=64>Val1</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 width=64>Val2</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 width=64>Val3</TD></TR><TR style="HEIGHT: 14.4pt" height=19><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 14.4pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66 height=19>1</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66>#a#b#c#</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66>#x#y#z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66>2</TD></TR><TR style="HEIGHT: 14.4pt" height=19><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 14.4pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66 height=19>2</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66>#f#</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66>#w#</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66>3</TD></TR></TBODY></TABLE>

Thanks in advance for your help

SKV
 

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
Sort by date Sort by votes
Try this. I tested it for 2 scenarios, but not all.
Code: 
Sub skvproc()
    
    Dim con As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim lngGroupID As Long
    Dim lngGroupIDPrev As Long
    Dim lngVal3Prev As Long
    Dim strSQL As String
    Dim strVal1 As String
    Dim strVal1Final As String
    Dim strVal1Prev As String
    Dim strVal2 As String
    Dim strVal2Prev As String
    
    lngGroupIDPrev = -1
    strVal1Prev = vbNullString
    strVal2Prev = vbNullString
    strVal1Final = vbNullString
    
    Set con = CurrentProject.Connection
    Set rst = New ADODB.Recordset
    rst.Open Source:="Select GroupID, Val1, Val2, Val3 from skv order by GroupID", ActiveConnection:=CurrentProject.Connection, options:=adCmdText
    
    If rst.EOF = False Then
        Do While rst.EOF = False
            lngGroupID = rst.Fields("GroupID").Value
            If lngGroupID = lngGroupIDPrev Then
                strVal1Final = strVal1Final & "#" & rst.Fields("Val1").Value
            Else
                If lngGroupIDPrev = -1 Then
                    '1st record.
                    strVal1Final = strVal1Final & "#" & rst.Fields("Val1").Value
                ElseIf lngGroupID <> lngGroupIDPrev And lngGroupIDPrev > 0 Then
                    'New Group Id
                    strSQL = "Insert Into skv2 (GroupID, Val1, Val3) Values ( " & lngGroupIDPrev & ", '" & strVal1Final & "', " & lngVal3Prev & ")"
                    con.Execute CommandText:=strSQL, options:=adCmdText
                    'strVal1Final = vbNullString
                    strVal1Final = "#" & rst.Fields("Val1").Value
                End If
            End If
            lngGroupIDPrev = lngGroupID
            strVal1Prev = rst.Fields("Val1").Value
            lngVal3Prev = rst.Fields("Val3").Value
            rst.MoveNext
        Loop
    End If
    
    'last record
    strSQL = "Insert Into skv2 (GroupID, Val1, Val3) Values ( " & lngGroupIDPrev & ", '" & strVal1Final & "', " & lngVal3Prev & ")"
    con.Execute CommandText:=strSQL, options:=adCmdText

    Set con = Nothing
    rst.Close
    Set rst = Nothing
End Sub
 
Upvote 0
You shouldn't need/want to do this.

The first thing you might want to address is your data structure - it is not a good idea having all these fields.

It's also not conducive to any sort of analysis or data manipulation.

Have a look at 'normalization'?

Believe me working with normalized data is a lot easier.:)
 
Upvote 0
GeofW said:
Try this. I tested it for 2 scenarios, but not all.
Code: 
Sub skvproc()
 
    Dim con As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim lngGroupID As Long
    Dim lngGroupIDPrev As Long
    Dim lngVal3Prev As Long
    Dim strSQL As String
    Dim strVal1 As String
    Dim strVal1Final As String
    Dim strVal1Prev As String
    Dim strVal2 As String
    Dim strVal2Prev As String
 
    lngGroupIDPrev = -1
    strVal1Prev = vbNullString
    strVal2Prev = vbNullString
    strVal1Final = vbNullString
 
    Set con = CurrentProject.Connection
    Set rst = New ADODB.Recordset
    rst.Open Source:="Select GroupID, Val1, Val2, Val3 from skv order by GroupID", ActiveConnection:=CurrentProject.Connection, options:=adCmdText
 
    If rst.EOF = False Then
        Do While rst.EOF = False
            lngGroupID = rst.Fields("GroupID").Value
            If lngGroupID = lngGroupIDPrev Then
                strVal1Final = strVal1Final & "#" & rst.Fields("Val1").Value
            Else
                If lngGroupIDPrev = -1 Then
                    '1st record.
                    strVal1Final = strVal1Final & "#" & rst.Fields("Val1").Value
                ElseIf lngGroupID <> lngGroupIDPrev And lngGroupIDPrev > 0 Then
                    'New Group Id
                    strSQL = "Insert Into skv2 (GroupID, Val1, Val3) Values ( " & lngGroupIDPrev & ", '" & strVal1Final & "', " & lngVal3Prev & ")"
                    con.Execute CommandText:=strSQL, options:=adCmdText
                    'strVal1Final = vbNullString
                    strVal1Final = "#" & rst.Fields("Val1").Value
                End If
            End If
            lngGroupIDPrev = lngGroupID
            strVal1Prev = rst.Fields("Val1").Value
            lngVal3Prev = rst.Fields("Val3").Value
            rst.MoveNext
        Loop
    End If
 
    'last record
    strSQL = "Insert Into skv2 (GroupID, Val1, Val3) Values ( " & lngGroupIDPrev & ", '" & strVal1Final & "', " & lngVal3Prev & ")"
    con.Execute CommandText:=strSQL, options:=adCmdText
 
    Set con = Nothing
    rst.Close
    Set rst = Nothing
End Sub
Click to expand...

Geof,
Thanks for your help. Can you please put some comments in the code to help me understand how the code is working. I am very new to VB and learning.

Thanks again
SKV
 
Upvote 0
SKV said:
Geof,
Thanks for your help. Can you please put some comments in the code to help me understand how the code is working. I am very new to VB and learning.

Thanks again
SKV
Click to expand...

Geoff - the code is not working on Access 2007. Do I need to change some settings to make it work
 
Upvote 0
Well, I have some comments in there! Step through the code to see what's happening. Put a breakpoint (F9) near the top and step through (F8) it.

Why is it not working? Give us some clues please.
 
Upvote 0
GeofW said:
Well, I have some comments in there! Step through the code to see what's happening. Put a breakpoint (F9) near the top and step through (F8) it.

Why is it not working? Give us some clues please.
Click to expand...

Geof - as soon as I try to run the macro I get an error : Compiled error "user-defined type not defined" and highlights the row
"Dim con As ADODB.Connection"

Do I need to activate something in the library? (I guess)

Thanks
SKV
 
Upvote 0
in the vba ide, go to tools, references, look for microsoft activex data objects 2.x library.
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Solved
VBA Function to Paste Table into Outlook Email Resulting in HTML language in Email
Replies
8
Views
537
smozgur
smozgur
A
  • Question Question
VBA - Automatically Break the Line in HTML format.
Replies
7
Views
2K
Attrazion
A
G
  • Question Question
Using Excel formula to create HTML code text referencing specific cells
Replies
0
Views
1K
gvsumich
G
E
  • Question Question
VBA code clean up
Replies
9
Views
482
mumps
mumps
E
  • Question Question
VBA for Web Scraping help
Replies
0
Views
902
epactheactor
E

Forum statistics

Threads
1,223,236
Messages
6,170,912
Members
452,366
Latest member
TePunaBloke

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top