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

[chriss_]

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

[chriss_]

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