I have a spreadsheet with 2 columns and more than million rows. The
first column is the id

Example of the data (2 columns)-

04731 CRM
04731 CRM
04731 CRM
04731 RVB
04731 RVB
25475 MMX
25475 MMX
25475 FRB
25475 FRB

Result desired (2 columns)-

04731 CRM; RVB
25475 FRB; MMX

Idea is to summarize the data and eliminate the duplicates

I am using the following Code in Excel it provides the desired result-

Sub testme()
Dim InputRng As Range
Dim wks As Worksheet
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long

Set wks = Worksheets("Sheet1")
With wks
Set InputRng = .Range("a1:b" & .Cells(.Rows.Count,
"A").End(xlUp).Row)
InputRng.Sort _
key1:=.Range("A1"), order1:=xlAscending, _
key2:=.Range("b1"), order2:=xlAscending, _
header:=xlYes

InputRng.AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=.Range("D1"),
Unique:=True

.Range("a1:c1").EntireColumn.Delete

FirstRow = 2 'headers in row 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = LastRow To FirstRow + 1 Step -1
If .Cells(iRow, "A").Value = .Cells(iRow - 1, "A").Value
Then
'same value
.Cells(iRow - 1, "B").Value _
= .Cells(iRow - 1, "B").Value _
& ", " & .Cells(iRow, "B").Value
.Rows(iRow).Delete
End If
Next iRow

End With

End Sub

Now my data is in access with more than a million records. Can anybody
help me with doing the same thing in access?

Any help is greatly appreciated.


Thanks !!!

If you want similar code in Access, maybe asking in a newsgroup dedicated to
Access would be best????

italia wrote:

I have a spreadsheet with 2 columns and more than million rows. The
first column is the id

Example of the data (2 columns)-

04731 CRM
04731 CRM
04731 CRM
04731 RVB
04731 RVB
25475 MMX
25475 MMX
25475 FRB
25475 FRB

Result desired (2 columns)-

04731 CRM; RVB
25475 FRB; MMX

Idea is to summarize the data and eliminate the duplicates

I am using the following Code in Excel it provides the desired result-

Sub testme()
Dim InputRng As Range
Dim wks As Worksheet
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long

Set wks = Worksheets("Sheet1")
With wks
Set InputRng = .Range("a1:b" & .Cells(.Rows.Count,
"A").End(xlUp).Row)
InputRng.Sort _
key1:=.Range("A1"), order1:=xlAscending, _
key2:=.Range("b1"), order2:=xlAscending, _
header:=xlYes

InputRng.AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=.Range("D1"),
Unique:=True

.Range("a1:c1").EntireColumn.Delete

FirstRow = 2 'headers in row 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = LastRow To FirstRow + 1 Step -1
If .Cells(iRow, "A").Value = .Cells(iRow - 1, "A").Value
Then
'same value
.Cells(iRow - 1, "B").Value _
= .Cells(iRow - 1, "B").Value _
& ", " & .Cells(iRow, "B").Value
.Rows(iRow).Delete
End If
Next iRow

End With

End Sub

Now my data is in access with more than a million records. Can anybody
help me with doing the same thing in access?

Any help is greatly appreciated.

Thanks !!!

--

Dave Peterson