Need help with VBA; tried coding but was unsuccessful (ಥ﹏ಥ)

[nlwid]

Hi all,

I am an engineer and recently I am faced with a task to keep track of the weight of our prototype during integration. The whole platform consist of multiple assemblies and sub-assemblies. My intention is to have an Excel sheet indicating that the weight of all child components are consolidated under the parent, if the weight of a higher assembly has already been inputted.

The following are some screenshots of the if the Excel sheet is working as intended.

(1 of 3) How the sheet will appear when no recording has been done.

(2 of 3) Assuming the highest level parent has the weight recorded, all subsequent lowel levels should indicate "Weight consolidated under parent" as shown

(3 of 3) If only the sub-assembly have the weight recorded, then only lowel levels of that sub-assembly should indicate "Weight consolidated under parent" as shown

I tried to achieve the above by formulas but hit a wall due to the multi-level nature of my list. In the end, I came to a conclusion that writing a VBA program is the only way. To try to achieve the above, I read up on VBA on forums and online tutorials and even borrowed a book before giving a shot on coding my first ever VBA program. However, it did not work as I intended.

Therefore, I hope the kind folks in this forum can assist in pointing me to the right direction. Below, I have copied the code of my VBA program for your reference. I understand that it will most likely be riddled with multiple programming errors. However, I still seek your patience and kind understanding in guiding me through this learning process. Thank you!

Private Sub Weight_Update(ByVal Target As Range)
    
' The variable KeyCells contains the cells that will
' cause a sheet update when they are changed.
    Dim KeyCells As Range
    
' The variable Compare_Address is the cell for which
' other comparison variables will take reference from
    Dim Compare_Address As Range

' The variable Input_Level is the level of the row
' item for which the weight has been imputted
    Dim Input_Level
        
' The variable Compare_Level is the level of the subsequent
' row items which will be compared to Input_Level
    Dim Compare_Level

' The variable Weight_Status defines whether the weight of the
' line item is consolidated by the parent
    Dim Weight_Status



Set KeyCells = Range("D:D")

Set Compare_Address = Range(Target.Address)

Input_Level = Offset(Target.Address, 0, -5)

Compare_Level = Offset(Compare_Address, 1, -5)



If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then



Do While True

    If Compare_Level > Input_Level Then
    Offset(Compare_Address, 1, 1) = "Weight consolidated under parent"
    Set Compare_Address = Range(Offset(Compare_Address, 1, 0))
    
Loop


End Sub

 

[CSmith]

How are you wanting your code to react? based on entry of the actual weight column? or?
Assumption is to simply just change background color of cells to green and add text to remarks column for any child?

 

[nlwid]

How are you wanting your code to react? based on entry of the actual weight column? or?
Assumption is to simply just change background color of cells to green and add text to remarks column for any child?

My intention is to have the sheet update whenever a figure is inputted in Column D

 

[Legacy 456155]

Not exactly robust, but with your desire to learn, you should be able to adapt it. I'm curious if there is a native formula solution?

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count = 1 Then
        If Not Intersect(Target, Range("D:D")) Is Nothing Then Weight_Update Target
    End If
End Sub

Private Sub Weight_Update(t As Range)
    Dim level As String
    
    level = t.Offset(, -2)
    Range("E2:E100").ClearContents
    If Len(t) > 0 Then
        Application.EnableEvents = False
        Do Until Not t.Offset(1, -2) > level
            Set t = t.Offset(1)
            t.Offset(, 1) = "Weight consolidated under parent"
        Loop
        Application.EnableEvents = True
    End If
End Sub

 

[nlwid]

Not exactly robust, but with your desire to learn, you should be able to adapt it. I'm curious if there is a native formula solution?

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count = 1 Then
        If Not Intersect(Target, Range("D:D")) Is Nothing Then Weight_Update Target
    End If
End Sub

Private Sub Weight_Update(t As Range)
    Dim level As String
   
    level = t.Offset(, -2)
    Range("E2:E100").ClearContents
    If Len(t) > 0 Then
        Application.EnableEvents = False
        Do Until Not t.Offset(1, -2) > level
            Set t = t.Offset(1)
            t.Offset(, 1) = "Weight consolidated under parent"
        Loop
        Application.EnableEvents = True
    End If
End Sub

Thank you! I will use this as a base line to learn and improve Will try to refine it to my intended result. Shall be back if I have no other options but to seek help again.

 

[CSmith]

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim KeyCells, rw As Range, tRow, sRow As Long
  Set KeyCells = Range("D:D")
    
  If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
    For Each rw In Target.Rows
      tRow = rw.Row
      sRow = tRow + 1
      If (Cells(tRow, 4).Value <> "" And Not IsEmpty(Cells(tRow, 4).Value)) Then
        Application.EnableEvents = False
        Cells(tRow, 4).Interior.Color = vbGreen
        Application.EnableEvents = True
        Do While ((Cells(tRow, 2).Value < Cells(sRow, 2).Value) And (Cells(sRow, 2).Value <> ""))
          Application.EnableEvents = False
          Cells(sRow, 5).Value = "Weight consolidated under parent"
          Cells(sRow, 4).Interior.Color = vbGreen
          Application.EnableEvents = True
          sRow = sRow + 1
        Loop
      End If
    Next rw
  End If
End Sub

 

[nlwid]

Not exactly robust, but with your desire to learn, you should be able to adapt it. I'm curious if there is a native formula solution?

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count = 1 Then
        If Not Intersect(Target, Range("D:D")) Is Nothing Then Weight_Update Target
    End If
End Sub

Private Sub Weight_Update(t As Range)
    Dim level As String
   
    level = t.Offset(, -2)
    Range("E2:E100").ClearContents
    If Len(t) > 0 Then
        Application.EnableEvents = False
        Do Until Not t.Offset(1, -2) > level
            Set t = t.Offset(1)
            t.Offset(, 1) = "Weight consolidated under parent"
        Loop
        Application.EnableEvents = True
    End If
End Sub

Tried using the above code and realise that it works. However, it seems there is something lacking in the code. The code actually resets the status of the list and only updates the children for the line item which the weight was inputted. Based on this, the following is what I think should be amended for the code.

- Instead of targeting the input cell and the children for update, the whole list should be updated whenever te weight column is updated

- To also ensure that the list works holistically, the parent assembly should reflect a dash when all children are filled. This could be accomplished by counting the number of children (via the loop) and checking whether the number of dashes and remarks tally.

I think the above is the logic flow I should be aiming for. Appreciate any kind comments to refine the code

 

[CSmith]

And you tried mine?

Tried using the above code and realise that it works. However, it seems there is something lacking in the code. The code actually resets the status of the list and only updates the children for the line item which the weight was inputted. Based on this, the following is what I think should be amended for the code.

- Instead of targeting the input cell and the children for update, the whole list should be updated whenever te weight column is updated

- To also ensure that the list works holistically, the parent assembly should reflect a dash when all children are filled. This could be accomplished by counting the number of children (via the loop) and checking whether the number of dashes and remarks tally.

I think the above is the logic flow I should be aiming for. Appreciate any kind comments to refine the code

Sub Button1_Click()
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim KeyCells, rw As Range, tRow, sRow As Long
  Set KeyCells = Range("D:D")
    
  If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
    For Each rw In Target.Rows
      tRow = rw.Row
      sRow = tRow + 1
      If (Cells(tRow, 4).Value <> "" And Not IsEmpty(Cells(tRow, 4).Value)) Then
        Application.EnableEvents = False
        Cells(tRow, 4).Interior.Color = vbGreen
        Application.EnableEvents = True
        Do While ((Cells(tRow, 2).Value < Cells(sRow, 2).Value) And (Cells(sRow, 2).Value <> ""))
          Application.EnableEvents = False
          Cells(sRow, 5).Value = "Weight consolidated under parent"
          Cells(sRow, 4).Value = "-"
          Cells(sRow, 4).Interior.Color = vbGreen
          Application.EnableEvents = True
          sRow = sRow + 1
        Loop
      End If
    Next rw
  End If
End Sub

 

[Legacy 456155]

Hello nlwid.

"Tried using the above code and realise that it works. However, it seems there is something lacking in the code. The code actually resets the status of the list and only updates the children for the line item which the weight was inputted. Based on this, the following is what I think should be amended for the code."

I'm under some assumptions here. For one, I'm assuming that if a child is assigned a value, the parent will not be. And also that each list will have a single top level 'A'. If that's not the case, we need to adjust our logic by your supplying a broader scope of need.

"Instead of targeting the input cell and the children for update, the whole list should be updated whenever the weight column is updated"

That's fine, but not really necessary if we understand the rules for each group and how each group in the hierarchy relates to other groups. It's also not very efficient. This doesn't really matter unless your lists are fairly large or may become large at some point in the future.

"To also ensure that the list works holistically, the parent assembly should reflect a dash when all children are filled. This could be accomplished by counting the number of children (via the loop) and checking whether the number of dashes and remarks tally"

The code already understands the parent-child distinction.

Maybe provide some more details about your entire list and post an example of before and after and typical data entry practices.

I'd still like to see a formula guru provide a shiny example. I suspect that this can be done without any code at all.

 

[nlwid]

And you tried mine?

Sub Button1_Click()
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim KeyCells, rw As Range, tRow, sRow As Long
  Set KeyCells = Range("D:D")
   
  If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
    For Each rw In Target.Rows
      tRow = rw.Row
      sRow = tRow + 1
      If (Cells(tRow, 4).Value <> "" And Not IsEmpty(Cells(tRow, 4).Value)) Then
        Application.EnableEvents = False
        Cells(tRow, 4).Interior.Color = vbGreen
        Application.EnableEvents = True
        Do While ((Cells(tRow, 2).Value < Cells(sRow, 2).Value) And (Cells(sRow, 2).Value <> ""))
          Application.EnableEvents = False
          Cells(sRow, 5).Value = "Weight consolidated under parent"
          Cells(sRow, 4).Value = "-"
          Cells(sRow, 4).Interior.Color = vbGreen
          Application.EnableEvents = True
          sRow = sRow + 1
        Loop
      End If
    Next rw
  End If
End Sub

Thanks! Can see that you included colour formatting. However, I have covered that aspect with conditional formatting

My intent is to only populate the remarks column with the comment "Weight consolidated under parent". All other formatting will then be taken care by conditional formatting. Apologies for not providing a clearer picture of my intention.

It seems the code allows the list to be populated. But it does not update any further when the weight is deleted