Concatenate duplicate Field (code by Miles Hitchen need modification)

[ElaineKuo]

Dear,

I have a shp file, whose attribute table contains duplicate rows with the same GID1 (esritypedouble).
Among the duplicate rows, their status could be R, S, W, O.
I wanna merge the status into one string field.

For instance,

GID1

434     R S  W  =>   R, S, W

I found the relevant code below but could not implement in my shoes.
(typemismatch in
Const LOCATIONID_FIELD As Double = "GID1")
Please kindly help and thanks. (the attached shp for use)

code
Public Sub ConcatenateField()
' Removes duplicate records (based on LocationID field)
' Concatenating the Business field.
'
' ---- Modify these values as appropriate ----
Const LOCATIONID_FIELD As Double = "GID1"
Const BUSINESS_FIELD As String = "C0440"
' --------------------------------------------
Dim pMxDoc As IMxDocument
Dim pSATblColl As IStandaloneTableCollection
Dim pTbl As ITable
Dim pCsr As ICursor
Dim pRow As IRow
Dim pNxtRow As IRow
Dim sLocID As String
Dim sNxtLocID As String
Dim sBus As String
Dim sNxtBus As String
Dim lLocIdx As Long
Dim lBusIdx As Long
Dim sConcat As String
Dim pTblSort As ITableSort
Dim pEditor As IEditor
Dim pID As New UID

    ' Make sure we're in an edit session
    pID.Value = "esriEditor.Editor"
    Set pEditor = Application.FindExtensionByCLSID(pID)
    If pEditor.EditState = esriStateNotEditing Then
        MsgBox "Please Start An Edit Session On The Table"
        Exit Sub
    End If
   
    ' Get a ref to the first table in the map
    Set pMxDoc = ThisDocument
    Set pSATblColl = pMxDoc.FocusMap
    Set pTbl = pSATblColl.StandaloneTable(0)
   
    ' Get the field indexes
    lLocIdx = pTbl.FindField(LOCATIONID_FIELD)
    lBusIdx = pTbl.FindField(BUSINESS_FIELD)
   
    ' Get a sorted cursor on the table
    Set pTblSort = New TableSort
    With pTblSort
        Set .Table = pTbl
        .Fields = LOCATIONID_FIELD + "," + BUSINESS_FIELD
        .Ascending(LOCATIONID_FIELD) = True
        .Ascending(BUSINESS_FIELD) = True
        .Sort Nothing
    End With
   
    ' Start an edit operation (so that it can be undone)
    pEditor.StartOperation
   
    ' Loop thru all the sorted records
    Set pCsr = pTblSort.Rows
    Set pRow = pCsr.NextRow
    sLocID = CStr(pRow.Value(lLocIdx))
    sBus = "," + pRow.Value(lBusIdx) + ","
    Set pNxtRow = pCsr.NextRow
   
    While Not pNxtRow Is Nothing
        sNxtLocID = CStr(pNxtRow.Value(lLocIdx))
        If sNxtLocID = sLocID Then
            ' Concatenate the Business field for duplicate records
            ' and delete the duplicates.
            ' Only concatenate unique Business field entries
            sNxtBus = pNxtRow.Value(lBusIdx)
            If InStr(sBus, "," + sNxtBus + ",") = 0 Then
                sBus = sBus + sNxtBus + ","
            End If
            pNxtRow.Delete
        Else
            'Store the record with the concatenated Business field
            sBus = Mid(sBus, 2, Len(sBus) - 2)
            sBus = Replace(sBus, ",", ", ")
            pRow.Value(lBusIdx) = sBus
            pRow.Store
            Set pRow = pNxtRow
            sLocID = CStr(pRow.Value(lLocIdx))
            sBus = "," + pRow.Value(lBusIdx) + ","
        End If
        ' Get the next record
        Set pNxtRow = pCsr.NextRow
    Wend

    ' Store the last record
    sBus = Mid(sBus, 2, Len(sBus) - 2)
    sBus = Replace(sBus, ",", ", ")
    pRow.Value(lBusIdx) = sBus
    pRow.Store

    ' Stop the edit operation
    pEditor.StopOperation "Concatenate Field"


    ' Inform the user we've finished
    MsgBox "Concatenation completed", vbInformation, ""

End Sub

[JeffMatson]

Even though your field is of type Double, the field name is still a string.  Just change your constant back to a String type:

'Const LOCATIONID_FIELD As Double = "GID1"
Const LOCATIONID_FIELD As String = "GID1"

[ElaineKuo]

Dear, Thanks for the help.

Here I have one more question.

The code was designed for standalone tables.
Is it possible to convert it for feature classes ?
Thanks.

code
Public Sub ConcatenateField()
' Removes duplicate records (based on LocationID field)
' Concatenating the Business field.
'
' ---- Modify these values as appropriate ----
Const LOCATIONID_FIELD As Double = "GID1"
Const BUSINESS_FIELD As String = "C0440"
' --------------------------------------------
Dim pMxDoc As IMxDocument
Dim pSATblColl As IStandaloneTableCollection
Dim pTbl As ITable
Dim pCsr As ICursor
Dim pRow As IRow
Dim pNxtRow As IRow
Dim sLocID As String
Dim sNxtLocID As String
Dim sBus As String
Dim sNxtBus As String
Dim lLocIdx As Long
Dim lBusIdx As Long
Dim sConcat As String
Dim pTblSort As ITableSort
Dim pEditor As IEditor
Dim pID As New UID

' Make sure we're in an edit session
pID.Value = "esriEditor.Editor"
Set pEditor = Application.FindExtensionByCLSID(pID)
If pEditor.EditState = esriStateNotEditing Then
MsgBox "Please Start An Edit Session On The Table"
Exit Sub
End If

' Get a ref to the first table in the map
Set pMxDoc = ThisDocument
Set pSATblColl = pMxDoc.FocusMap
Set pTbl = pSATblColl.StandaloneTable(0)

' Get the field indexes
lLocIdx = pTbl.FindField(LOCATIONID_FIELD)
lBusIdx = pTbl.FindField(BUSINESS_FIELD)

' Get a sorted cursor on the table
Set pTblSort = New TableSort
With pTblSort
Set .Table = pTbl
.Fields = LOCATIONID_FIELD + "," + BUSINESS_FIELD
.Ascending(LOCATIONID_FIELD) = True
.Ascending(BUSINESS_FIELD) = True
.Sort Nothing
End With

' Start an edit operation (so that it can be undone)
pEditor.StartOperation

' Loop thru all the sorted records
Set pCsr = pTblSort.Rows
Set pRow = pCsr.NextRow
sLocID = CStr(pRow.Value(lLocIdx))
sBus = "," + pRow.Value(lBusIdx) + ","
Set pNxtRow = pCsr.NextRow

While Not pNxtRow Is Nothing
sNxtLocID = CStr(pNxtRow.Value(lLocIdx))
If sNxtLocID = sLocID Then
' Concatenate the Business field for duplicate records
' and delete the duplicates.
' Only concatenate unique Business field entries
sNxtBus = pNxtRow.Value(lBusIdx)
If InStr(sBus, "," + sNxtBus + ",") = 0 Then
sBus = sBus + sNxtBus + ","
End If
pNxtRow.Delete
Else
'Store the record with the concatenated Business field
sBus = Mid(sBus, 2, Len(sBus) - 2)
sBus = Replace(sBus, ",", ", ")
pRow.Value(lBusIdx) = sBus
pRow.Store
Set pRow = pNxtRow
sLocID = CStr(pRow.Value(lLocIdx))
sBus = "," + pRow.Value(lBusIdx) + ","
End If
' Get the next record
Set pNxtRow = pCsr.NextRow
Wend

' Store the last record
sBus = Mid(sBus, 2, Len(sBus) - 2)
sBus = Replace(sBus, ",", ", ")
pRow.Value(lBusIdx) = sBus
pRow.Store

' Stop the edit operation
pEditor.StopOperation "Concatenate Field"


' Inform the user we've finished
MsgBox "Concatenation completed", vbInformation, ""

End Sub

[JeffMatson]

Here is a sample written by Michael Knight, that I had saved long ago - basically you can replace:

ITable with IFeatureClass
ICursor with IFeatureCursor
IRow with IFeature


Sub LoopThroughFeatures()
    Dim pMxDoc As IMxDocument
    Dim pMap As IMap
    Dim pFLayer As IFeatureLayer
    Dim pFClass As IFeatureClass
    Dim pFCursor As IFeatureCursor
    Dim pFeature As IFeature
   
    Set pMxDoc = Application.Document
    Set pMap = pMxDoc.FocusMap
    Set pFLayer = pMap.Layer(0)
    Set pFClass = pFLayer.FeatureClass   
    Set pFCursor = pFClass.Search(Nothing, False) 'change to True if editing features
    Set pFeature = pFCursor.NextFeature
   
    Do While Not pFeature Is Nothing
        'Debug.Print pFeature.OID
        Set pFeature = pFCursor.NextFeature
    Loop
End Sub