VBA/Macro's help (newby alert!)

Discussion created by ohhdanielson on Jan 22, 2013
Latest reply on Jan 25, 2013 by ohhdanielson
Hi guys,

First post here... I work in GIS, using ArcGIS 9.2, and I am a complete newby to VBA macro's scripts etc.
I hope this is the right place to post this (did a search for VBA and this thread seem to come up).

Basically I only started using VBA because a user wanted to add a count of unique values to one of his shapefiles, and then the count to appear in his legend.

The count field displays the count when in layer properies>unique values, but as soon as you come out of that the count ends.

So I found a macro which takes existing Unique Value and calculates feature counts for each value, adding the count to each Class Label. Class Labels appear in the ArcMap Table of Contents and Legend.

After a bit of trial and error I got the script to work. The problem is the script doesn't work on every shapefile, it works on some but not others.

Here is the script;

Const CONCAT_CHAR = vbNewLine

Option Explicit

Sub UniqueValues_LabelCount_and_DescripFromField()

Dim pDoc As IMxDocument
Set pDoc = ThisDocument
Dim pMap As IMap
Set pMap = pDoc.FocusMap
Dim pGeoLayer As IGeoFeatureLayer
Set pGeoLayer = pMap.Layer(0)

If Not TypeOf pGeoLayer.Renderer Is IUniqueValueRenderer Then
MsgBox "Current symbology is not Unique values. Exiting."
Exit Sub
End If

Dim pUVRend As IUniqueValueRenderer
Set pUVRend = pGeoLayer.Renderer

If pUVRend.FieldCount > 1 Then
MsgBox "Current Unique values symbology is based on multiple fields. Exiting."
Exit Sub
End If

Dim sFieldName As String
sFieldName = pUVRend.Field(0)

Dim i As Integer
Dim varValue As Variant

Dim pFeatClass As IFeatureClass
Set pFeatClass = pGeoLayer.FeatureClass

Dim varLabelDescrip As Variant
For i = 0 To pUVRend.ValueCount - 1
varValue = pUVRend.Value(i)
varLabelDescrip = GetLabelDescription(pFeatClass, pUVRend.Field(0), varValue)
pUVRend.Label(varValue) = varLabelDescrip(0)
pUVRend.Description(varValue) = varLabelDescrip(1)
Next i

End Sub

Private Function GetLabelDescription(pFeatClass As IFeatureClass, ValField As String, Value As Variant) As Variant
' returns an array of length 2
' (0) is the new label (string) appended with count of features
' (1) is the new descrip (string) driven from DESCRIP_FIELD

Dim pQueryFilter As IQueryFilter
Set pQueryFilter = New QueryFilter

pQueryFilter.WhereClause = ValField & " = '" & CStr(Value) & "'"
pQueryFilter.AddField DESCRIP_FIELD
Dim pFeatCursor As IFeatureCursor
Set pFeatCursor = pFeatClass.Search(pQueryFilter, False)

' ---------------------------------------------------------
' Description
Dim pFeat As IFeature
Dim sDescrip As String
Dim iDescrip As Integer
iDescrip = pFeatClass.Fields.FindField(DESCRIP_FIELD)
Set pFeat = pFeatCursor.NextFeature

Dim iCount As Integer
iCount = 0
Dim bCountsDetermined As Boolean
bCountsDetermined = False

bCountsDetermined = True
Do While Not pFeat Is Nothing
iCount = iCount + 1
If sDescrip <> "" Then sDescrip = sDescrip + CONCAT_CHAR
sDescrip = sDescrip + CStr(pFeat.Value(iDescrip)) ' get value from DESCRIP_FIELD
Set pFeat = pFeatCursor.NextFeature

Else ' only get descrip from first feature found
If Not pFeat Is Nothing Then
sDescrip = CStr(pFeat.Value(iDescrip)) ' get value from DESCRIP_FIELD
End If

End If

' ---------------------------------------------------------
' Label
If Not bCountsDetermined Then
' optimization: re-query only if we don't
' already have the counts from above
iCount = pFeatClass.FeatureCount(pQueryFilter)
End If
Dim sLabel As String
sLabel = Value & " (" & iCount & ") "

' ---------------------------------------------------------
' setup return array and return
Dim sReturnArray(2) As String
sReturnArray(0) = sLabel
sReturnArray(1) = sDescrip

GetLabelDescription = sReturnArray

End Function

I modify the constants for my particular data and situation (so essentially change 'STATE_NAME' to whatever the field im using is), it worked for the particular shapefile our user was using, but out of interest I tried it with a few other shapefiles, and it works for some and not others, the error message sometimes varies, but the latest one read ' Run-time error '-2147220985 (80040207) Automation error. The owner SID on a per-user subscription doesn't exist'.

Like I said above, I am a complete newby to this, and only started using it last week... it could be something obvious, so apologies if so.

Any help appreciated