Changing value of group of cells by one cell value change

C

csbaros

New Member
Joined
Apr 22, 2021
Messages
25
Office Version
  1. 2016
Platform
  1. Windows
Dear Folks,

Please help me in the following:
There are couple of hundred units, dispersed randomly on the sheet. There is two different type of unit. (unit border marked by thick line).
Unit types:
- 3x27 cells unit: contains: 2x12 pcs of ⚪, as a default value
- 3x9 cells: contains: 2x5 pcs of ⚪, as a default value

Small part of the sheet:
1620317115803.png

Second cell in first and third row in every 3x27 unit contains a dropdown menu. (In the 3x9 unit the dropdown is in the first cell)
I would like reach, that the changing this dropdown will change the whole row, like this (change all ⚪ for ⚫ in the row).

1620318637116.png



And then, changing the 2nd cell of third row:
1620317655398.png

Or randomly choose any of the 1st or 3rd row in any unit in the sheet:

1620318108122.png


The xls is here: example.xlsx

I suppose, probably could be solved by a VBA code, but I don't have any clue about it.

Please help me. This would be almost the last step in my project. (If my description wasn't clear, I would try it again. If it need, I could upload the big sheet, not just this small one)

Thanks a lot

Csaba
 

Attachments

  • 1620317503772.png
    1620317503772.png
    6.7 KB · Views: 6
  • 1620317626909.png
    1620317626909.png
    221.9 KB · Views: 5
  • 1620317907795.png
    1620317907795.png
    6.9 KB · Views: 6
  • 1620318547880.png
    1620318547880.png
    6.7 KB · Views: 7
Sort by date Sort by votes
Here is the code with the color change code working for me:
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim clr As Long, blk As Long, rng As Range
    Dim r As Long, c As Long
    Dim TargetRow As Long, TargetColumn As Long
    Dim UnitTypeCodeCell As Range, arr As Variant
    
    If Target.CountLarge > 1 Then Exit Sub
    
    Application.EnableEvents = False
    TargetRow = Target.Row
    TargetColumn = Target.Column
    If Cells(TargetRow + 1, TargetColumn - 1).Value = "0F" Then
      Set UnitTypeCodeCell = Cells(TargetRow + 1, TargetColumn - 1)
    ElseIf Cells(TargetRow - 1, TargetColumn - 1).Value = "0F" Then
      Set UnitTypeCodeCell = Cells(TargetRow - 1, TargetColumn - 1)
    ElseIf Cells(TargetRow + 1, TargetColumn).Value = "0S" Then
      Set UnitTypeCodeCell = Cells(TargetRow + 1, TargetColumn)
    ElseIf Cells(TargetRow - 1, TargetColumn).Value = "0S" Then
      Set UnitTypeCodeCell = Cells(TargetRow - 1, TargetColumn)
    Else
      Application.EnableEvents = True
      Exit Sub
    End If
    
    Select Case UnitTypeCodeCell
        Case "0S"
            clr = 16777215
            blk = 8
            arr = Array(2, 4, 6, 8)
        Case "1S"
            clr = 65535
            blk = 8
        Case "2S"
            clr = 49407
            blk = 8
        Case "3S"
            clr = 5287936
            blk = 8
        Case "4S"
            clr = 12611584
            blk = 8
        Case "0F"
            clr = 16777215
            blk = 26
            arr = Array(2, 4, 6, 9, 11, 13, 15, 18, 20, 22, 24)
        Case "1F"
            clr = 65535
            blk = 26
        Case "2F"
            clr = 49407
            blk = 26
        Case "3F"
            clr = 5287936
            blk = 26
        Case "4F"
            clr = 12611584
            blk = 26
        Case "0_C"
            clr = 16777215
            blk = 2
        Case "1_C"
            clr = 65535
            blk = 2
        Case "2_C"
            clr = 49407
            blk = 2
        Case "3_C"
            clr = 5287936
            blk = 2
        Case "4_C"
            clr = 12611584
            blk = 2
        Case "0_S"
            clr = 16777215
            blk = 1
        Case "1_S"
            clr = 65535
            blk = 1
        Case "2_S"
            clr = 49407
            blk = 1
        Case "3_S"
            clr = 5287936
            blk = 1
        Case "4_S"
            clr = 192
            blk = 1
        Case "5_S"
            clr = 12611584
            blk = 1
            
    End Select
    
    If blk > 0 Then
      r = Target.Row
      c = Target.Column
      Select Case blk
        Case 1
          Set rng = Range(Cells(r, c), Cells(r + 2, c + 8))
          rng.Interior.Color = clr
        Case 2
          Set rng = Range(Cells(r, c), Cells(r, c))
          rng.Interior.Color = clr
        Case Else ' > 2 '
          Set rng = Range(Cells(r - 1, c), Cells(r + 1, c - 1 + blk))
          rng.Interior.Color = clr
          For i = LBound(arr) To UBound(arr)
              Cells(TargetRow, TargetColumn + arr(i)) = Target.Value
          Next i
      End Select
    Else
      ' blk is LE 0
    End If
    Application.EnableEvents = True
End Sub
 
Upvote 0

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Sorry to say but it's still not properly working.
I've uploaded here:
If it is set to "0F" or "0S", it change the circles. At the other settings ie. "1F", "2F", not change them. And the color changing doesn't work also.
I've uploaded here:
szolnok1_v2.xlsm

May I ask you to check it ? I have no clue how to fix it.

Thank you very much
 
Upvote 0
csbaros, I don't find any "1F" or "2F" on the sheet. what distinguishes a "1F" from a "0F"?
 
Upvote 0
vw412 said:
csbaros, I don't find any "1F" or "2F" on the sheet. what distinguishes a "1F" from a "0F"?
Click to expand...
This is value of the dropdown (data validation) of first cell of second row in case of both type unit.
 
Upvote 0
I guess I need to know how with code I can determine the "xF" of the cells with the dropdown? Since I don't find any reference to "1F" or "2F" any where in the sheet, I can't determine what it is in code. I made an assumption that the "0F" or "0S" in the each of the tables referred to the entire table. Was that a correct assumption? How is "1F",etc. assigned?
 
Upvote 0
Sorry, I afraid I'm lost now.
I try to explain it:
"0F", "1F", "2F" etc referred for one "F"ull table (3x27cells)
"0S", "1S", "2S" etc referred for one "S"mall table (3x9 cells)
They represent different work stage of the certain table.
I've set "0F" and "0S" as the default value for all tables.
At setting "0F" or "0S" should possible to switch between empty and black circles. In the other settings of "xF" and "xS", I don't want to change between the circles.

Please try this. This was the starting phase, maybe it clarifies:

szolnok1_v3.xlsm

I hope this something around the correct answer for you. Sorry if I'm blurry.
 
Upvote 0
csbaros, my apologies, I am the "blurry one". I think I understand how this should work. If the center row of a table is marked "0F" or "0S" then the circles in the other two rows of the table should be allowed to change from empty to black. If the center row of a table is marked "1F" or "1S" then the circles should not be allowed to change but the color of the table should change. You plan to change only 1 row of circles at a time, not all circles in a table at a time. Is that correct? But if a table is marked "1F" then all modules of the table should change to the same color, correct?
 
Upvote 0
I suppose, all your statement correct now. That's, how it should be.

Thank you very much all of your effort.
 
Upvote 0
Here is some updated code. I think it is working as desired now. Note there is no test to be sure circles are black if changing to "1F".
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim clr As Long, blk As Long, rng As Range
    Dim r As Long, c As Long
    Dim TargetRow As Long, TargetColumn As Long
    Dim UnitTypeCodeCell As Range, arr As Variant
    
    If Target.CountLarge > 1 Then Exit Sub
    
    Application.EnableEvents = False
    TargetRow = Target.Row
    TargetColumn = Target.Column
    If Cells(TargetRow + 1, TargetColumn - 1).Value Like "#F" Then
      Set UnitTypeCodeCell = Cells(TargetRow + 1, TargetColumn - 1)
    ElseIf Cells(TargetRow - 1, TargetColumn - 1).Value Like "#F" Then
      Set UnitTypeCodeCell = Cells(TargetRow - 1, TargetColumn - 1)
    ElseIf Cells(TargetRow + 1, TargetColumn).Value Like "#S" Then
      Set UnitTypeCodeCell = Cells(TargetRow + 1, TargetColumn)
    ElseIf Cells(TargetRow - 1, TargetColumn).Value Like "#S" Then
      Set UnitTypeCodeCell = Cells(TargetRow - 1, TargetColumn)
    ElseIf Cells(TargetRow, TargetColumn).Value Like "#[FS]" Then
      Set UnitTypeCodeCell = Cells(TargetRow, TargetColumn)
    Else
      Application.EnableEvents = True
      Exit Sub
    End If
    
    Select Case UnitTypeCodeCell
        Case "0F", "0S"
            clr = Target.Offset(2, 0).Interior.Color
            If Right(UnitTypeCodeCell, 1) = "F" Then
              blk = 26
              arr = Array(2, 4, 6, 9, 11, 13, 15, 18, 20, 22, 24)
            Else
              blk = 8
              arr = Array(2, 4, 6, 8)
            End If
        Case "1F", "1S"
            clr = 65535
            blk = IIf(Right(UnitTypeCodeCell, 1) = "F", 26, 8)
        Case "2F", "2S"
            clr = 49407
            blk = IIf(Right(UnitTypeCodeCell, 1) = "F", 26, 8)
        Case "3F", "3S"
            clr = 5287936
            blk = IIf(Right(UnitTypeCodeCell, 1) = "F", 26, 8)
        Case "4F", "4S"
            clr = 12611584
            blk = IIf(Right(UnitTypeCodeCell, 1) = "F", 26, 8)
        Case "0_C"
            clr = 16777215
            blk = 2
        Case "1_C"
            clr = 65535
            blk = 2
        Case "2_C"
            clr = 49407
            blk = 2
        Case "3_C"
            clr = 5287936
            blk = 2
        Case "4_C"
            clr = 12611584
            blk = 2
        Case "0_S"
            clr = 16777215
            blk = 1
        Case "1_S"
            clr = 65535
            blk = 1
        Case "2_S"
            clr = 49407
            blk = 1
        Case "3_S"
            clr = 5287936
            blk = 1
        Case "4_S"
            clr = 192
            blk = 1
        Case "5_S"
            clr = 12611584
            blk = 1
            
    End Select
    
    If blk > 0 Then
      r = Target.Row
      c = Target.Column
      Select Case blk
        Case 1
          Set rng = Range(Cells(r, c), Cells(r + 2, c + 8))
          rng.Interior.Color = clr
        Case 2
          Set rng = Range(Cells(r, c), Cells(r, c))
          rng.Interior.Color = clr
        Case Else ' > 2
          Set rng = Range(Cells(r - 1, c), Cells(r + 1, c + blk))
          rng.Interior.Color = clr
          If Not Target.Address = UnitTypeCodeCell.Address Then
            For i = LBound(arr) To UBound(arr)
                Cells(TargetRow, TargetColumn + arr(i)) = Target.Value
            Next i
          End If
      End Select
    Else
      ' blk is LE 0
    End If
    Application.EnableEvents = True
End Sub
 
Upvote 0
Thank you. Now it works, as it suppose to.

I only find one more thing:

If it's "0F" or "0S" there is all ok. It switch between the circles properly.
But if it "1F", "2F", "1S" etc. and I switch between the circles then comes this:
1620598662792.png


It doesn't mean that I would like to switch between circles if not "0F" or "0S", but somebody could push the circle dropdown selector accidentally anytime.

Would you be so kind and solve this one as well ?
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question
Create new sheets based on criteria in a table and value in a cell
Replies
6
Views
272
Herakles
H
C
  • Question
Cursor not changing from '+' to 'hand' on a couple of random cells with hyperlinks
Replies
0
Views
94
centurymantra
C
C
  • Question
Finding any two values in each cell text in a column of cells with both values as one Textbox1 variable
2
Replies
10
Views
223
chazrab
C
C
  • Solved
Group of cells background colouring using VBA
Replies
5
Views
392
GWteB
GWteB
A
  • Question
Lookup value based on multiple criteria where one is searching a cell for specific text string
Replies
0
Views
255
alex0182828
A

Forum statistics

Threads
1,214,805
Messages
6,121,656
Members
449,045
Latest member
Marcus05

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top