Update a column in Shapefile A by summing Data of Shapefile B (VBA)

chriss_ — Tue, 25 May 2010 09:17:30 GMT

Hi!

I ve been programming on this for quite a while but I cant get it run.

I ve a layer with Places. This has the Fields "Area_CODE" and "Storage".
and I ve a Layer Flows. This has the Fields "To_" and "Amount"

Now I want to calculate the Field "Storage" from the Layer Flow. I wanna sum up all Fields(Flow) "Amount" where the Field(Flow) "To_" is the same as the Field (Area) "CODE_AREA". The resulting sum I want to write in the Field(AREA) "Storage".

I always get the error: Automation error. Anybody any idea how to fix this code?
Best regards
chris s.

Private Sub CalculateField()

' Access the Feature in Layer Flow whre fields should be summed up
    Dim pMxDoc As IMxDocument
    Dim pFeatLayer As IFeatureLayer
    Dim pFeatureClass As IFeatureClass
    Dim pFeatureCursor As IFeatureCursor
    Dim pField As IField
    Dim pFeature As IFeature

    Set pMxDoc = ThisDocument
    Set pFeatLayer = pMxDoc.FocusMap.Layer(0)
    Set pFeatureClass = pFeatLayer.FeatureClass
    Set pFeatureCursor = pFeatureClass.Search(Nothing, False)
    Set pFeature = pFeatureCursor.NextFeature

    ' Access the Feature in Layer AREA that shall be calculated
    Dim pFeatLayer2 As IFeatureLayer
    Dim pFeatureClass2 As IFeatureClass
    Dim pFeatureCursor2 As IFeatureCursor
    Dim pField2 As IField
    Dim pFeature2 As IFeature

    Set pFeatLayer2 = pMxDoc.FocusMap.Layer(1)
    Set pFeatureClass2 = pFeatLayer2.FeatureClass
    Set pFeatureCursor2 = pFeatureClass2.Search(Nothing, False)
    Set pFeature2 = pFeatureCursor2.NextFeature

   'Dim Variables
    Dim pAmount As Double
    Dim n As Double
    Dim m As String
    Dim nTo As String



   'Do Until Loop to step through each AREA Layer feature
   Do Until pFeature2 Is Nothing

m = pFeature2.Value(pFeature.Fields.FindField("AREA_CODE"))

   n = 0


    'Do until Loop to step through each Flow Layer Feature and sum it up if the Field "To_" ="AREA_CODE"
    Do Until pFeature Is Nothing

        pAmount = pFeature.Value(pFeature.Fields.FindField("Amount"))
        nTo = pFeature.Value(pFeature.Fields.FindField("To_"))
            If nTo = m Then
                 n = pAmount + n

            Else: n = n
            End If
        Set pFeature = pFeatureCursor.NextFeature
    Loop

   pFeature2.Value(Storage) = n
   pFeatureCursor2.UpdateFeature pFeature2

    Set pFeature2 = pFeatureCursor2.NextFeature

   Loop


End Sub

Re: Update a column in Shapefile A by summing Data of Shapefile B (VBA)

chriss_ — Thu, 27 May 2010 02:47:50 GMT

Hi!

So if ever anybody has the same problem, I finally managed to get the Code run.

Private Sub CalculateField()

' Access the Feature in Layer Flow whre fields should be summed up
    Dim pMxDoc As IMxDocument
    Dim pFeatLayer As IFeatureLayer
    Dim pFeatureClass As IFeatureClass
    Dim pFeatureCursor As IFeatureCursor
    Dim pField As IField
    Dim pFeature As IFeature

        Set pMxDoc = ThisDocument
    Set pFeatLayer = pMxDoc.FocusMap.Layer(0)
    Set pFeatureClass = pFeatLayer.FeatureClass
    Set pFeatureCursor = pFeatureClass.Search(Nothing, False)
    Set pFeature = pFeatureCursor.NextFeature

    ' Access the Feature in Layer AREA that shall be calculated
    Dim pFeatLayer2 As IFeatureLayer
    Dim pFeatureClass2 As IFeatureClass
    Dim pFeatureCursor2 As IFeatureCursor
    Dim pField2 As IField
    Dim pFeature2 As IFeature

    Set pFeatLayer2 = pMxDoc.FocusMap.Layer(1)
    Set pFeatureClass2 = pFeatLayer2.FeatureClass
    Set pFeatureCursor2 = pFeatureClass2.Search(Nothing, False)
    Set pFeature2 = pFeatureCursor2.NextFeature

   'Dim Variables
    Dim pAmount As Double
    Dim n As Double
    Dim m As String
    Dim nTo As String
    Dim Storage As Double

    ' Prepare a feature cursor for update

            Dim pUpdateFeaturesU As IFeatureCursor
            Set pFeatureClassU = pFeatLayer2.FeatureClass
            Set pUpdateFeaturesU = pFeatureClass2.Update(Nothing, False)
            Dim indexClass As Integer
            Dim pFeatureU As IFeature
            indexClass = pUpdateFeaturesU.FindField("Storage")
            Set pFeatureU = pUpdateFeaturesU.NextFeature

   'Do Until Loop to step through each AREA Layer feature
    Do Until pFeature2 Is Nothing
m = pFeature2.Value(pFeature2.Fields.FindField("AREA_CODE"))
n = 0

    'Do until Loop to step through each Flow Layer Feature and sum it up if the Field "To_" ="AREA_CODE"

Do Until pFeature Is Nothing
        pAmount = pFeature.Value(pFeature.Fields.FindField("Amount"))
        nTo = pFeature.Value(pFeature.Fields.FindField("To_"))
            If nTo = m Then
                 n = pAmount + n

            Else: n = n
            End If
        Set pFeature = pFeatureCursor.NextFeature
    Loop

    Set pFeatureCursor = pFeatureClass.Search(Nothing, False)
    Set pFeature = pFeatureCursor.NextFeature

            pFeatureU.Value(indexClass) = n
            pUpdateFeaturesU.UpdateFeature pFeatureU

     Set pFeature2 = pFeatureCursor2.NextFeature
     Set pFeatureU = pUpdateFeaturesU.NextFeature
   Loop
End Sub

Hope that helps someone out there

CU

topic Re: Update a column in Shapefile A by summing Data of Shapefile B (VBA) in ArcObjects SDK Questions

Update a column in Shapefile A by summing Data of Shapefile B (VBA)

Re: Update a column in Shapefile A by summing Data of Shapefile B (VBA)