E9 Copedant Pedal Changes

[rvan07]

Hello Mr Excel,
The spreadsheet pic shows cell C3 is active and is generating the changes in cells C17,C22 as per the code. All good.
This is currently the only cell with code in column C and the code works as it should.
The Problem:
I added coding for cell B3 which, when active, generates changes in cells B17,B22, and the coding for cell B4 which, when active, generates changes in cells B15, B18. Everything was working as it should until I added the coding for cell B5 which, when active, was to generate changes in cells B16,B17. B17 did NOT respond.
I suspect there is a conflict because B17 is 'common' in the coding for both B3 and B5.
Is there a 'statement' that would allow this 'common' cell to respond as per the code?
I suspect similar conflicts will occur when coding for cells B6 thru B11 as these cells, when active, will also generate changes in 'common' cells within B13 to B22.
Regarding your response, please note I am new to VBA.
Thank you kindly,
Ron

 

[StephenCrump]

It's not completely clear what is happening, or not happening, based on the pictures you've posted.

But I'm sure this can be done far more succinctly (as @Joe4 also observed in your related post Display the result in the active cell in another cell)

Is there any "pattern" to this 108 cells you want to apply this to? If not, it is going to be VERY cumbersome, as you are going to need to explicitly have 108 cell references in your code!

Can you describe what it is you're trying to do, showing us the full table of pitches to help illustrate?

Rather than posting pictures, it's best if you can use the XL2BB add-in to post screenshots, and post any code using the code tags, i.e. the "</>"button above. That way, we can easily copy/paste your layout and code for testing.

 

[rvan07]

It's not completely clear what is happening, or not happening, based on the pictures you've posted.

But I'm sure this can be done far more succinctly (as @Joe4 also observed in your related post Display the result in the active cell in another cell)



Can you describe what it is you're trying to do, showing us the full table of pitches to help illustrate?

Rather than posting pictures, it's best if you can use the XL2BB add-in to post screenshots, and post any code using the code tags, i.e. the "</>"button above. That way, we can easily copy/paste your layout and code for testing.

Thank you very much for replying. I will set up XL2BB and carefully think thru the explaination and submit it in the next couple of days.
Ron

 

[rvan07]

What I am trying to do:
A pedal steel guitar typically has 10 strings tuned to various pitches. It also has 3 foot pedals and 2 knee levers which when pressed individually or in combination, results in a specific change in pitch in one or more of the strings.
For example: When Pedal A is pressed, it raises the pitch of strings 5 and 6 from the note B to note C#.

I want the Excel worksheet to show the changes in pitch resulting from a pedal or knee lever being pressed.
For example: When cell B3 is active, the value in cells B17 and B22 wil change from value "B" to value "C#" and the interior color of cells B17 and B22 will turn yellow to provide a visual flag of which value has changed.
When B3 is not active, the value in cells B17 and B22 change back to value "B" and have no interior color.

Cells in rows 3 thru 11 represent the pedals, levers and their usable combinations.
Cells in rows 13 thru 22 represent the strings.
The columns B thru N represent the fret positions along the fret board
The values shown in cells B13 thru N22 are the notes resulting from laying a steel bar across the strings at specific marked positions (Frets) along the guitar neck.
Musical Note Names in one octave: A A# B C C# D D# E F F# G G# (and cycle back to A)
The musical distance between any Note and the Note next to it is called One semi-tone.
Ex: C# to D is One semi-tone. Similarly, E to F# is Two semi-tones.
Here are the changes in value that must occur in 'target cells' in range B13 thru B22 when a cell in range B3 thru B11 is active.

B3 raises value B17,B22 Two semi-tones
B4 raises value BB15,B18 One semi-tone
B5 raises value B16,B17 Two semi-tones
B6 lowers value B16.B20 One semi-tone
B7 raises value B16,B20 One semi-tone
B8 raises value B17,B22 Two semi-tones and raises value BB15,B18 One semi-tone
B9 raises value BB15,B18 One semi-tone and raises value B16,B17 Two semi-tones
B10 raises value B17,B22 Two semi-tones and raises value B16,B20 One semi-tone
B11 raises value BB15,B18 One semi-tone and lowers value B16.B20 One semi-tone

The code sequence in column B must repeat thru each successive column thru to column N.
The 'target cell' values throughout each successive column must increase by One semi-tone.
The few crude examples of code I included here hopefully provide an example.
The coding task appears to become very complex because certain 'target cells' within a column are referenced more than once. Example: Cells B3, B5, B8, B9, B10 each reference 'target cell' B17.

E9 Copedant VBA Coded Pedal Changes.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
2	Fret	Open	1	2	3	4	5	6	7	8	9	10	11	12
3	Pedal A
4	Pedal B
5	Pedal C
6	Lever D
7	Lever F
8	Pedals A+ B
9	Pedals B+ C
10	Pedal A+ F
11	Pedal B + D
12	String														String
13	1	F#	G	G#	A	A#	B	C	C#	D	D#	E	F	F#	1
14	2	D#	E	F	F#	G	G#	A	A#	B	C	C#	D	D#	2
15	3	G#	A	A#	B	C	C#	D	D#	E	F	F#	G	G#	3
16	4	E	F	F#	G	G#	A	A#	B	C	C#	D	D#	E	4
17	5	B	C	C#	D	D#	E	F	F#	G	G#	A	A#	B	5
18	6	G#	A	A#	B	C	C#	D	D#	E	F	F#	G	G#	6
19	7	F#	G	G#	A	A#	B	C	C#	D	D#	E	F	F#	7
20	8	E	F	F#	G	G#	A	A#	B	C	C#	D	D#	E	8
21	9	D	D#	E	F	F#	G	G#	A	A#	B	C	C#	D	9
22	10	B	C	C#	D	D#	E	F	F#	G	G#	A	A#	B	10
Sheet1

 

[StephenCrump]

Something along these lines perhaps?

I'll leave it to you to populate Cases 3 to 8 in the VBA code

I wouldn't use the SelectionChange event myself, as it will slow down the workbook. But we could speed things up a little by monitoring both the current and the previous selection - if both are outside the PedalsAndLevers range, we can simply exit the Sub, as no cells will need changing.

copedent.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q
1
2	Fret		Open	1	2	3	4	5	6	7	8	9	10	11	12		Pitches
3	Pedal A																A
4	Pedal B																A#
5	Pedal C																B
6	Lever D																C
7	Lever F																C#
8	Pedals A+ B																D
9	Pedals B+ C																D#
10	Pedal A+ F																E
11	Pedal B + D																F
12																	F#
13	String	START															G
14	1	F#	F#	G	G#	A	A#	B	C	C#	D	D#	E	F	F#		G#
15	2	D#	D#	E	F	F#	G	G#	A	A#	B	C	C#	D	D#
16	3	G#	G#	A	A#	B	C	C#	D	D#	E	F	F#	G	G#
17	4	E	E	F	F#	G	G#	A	A#	B	C	C#	D	D#	E
18	5	B	B	C	C#	D	D#	E	F	F#	G	G#	A	A#	B
19	6	G#	G#	A	A#	B	C	C#	D	D#	E	F	F#	G	G#
20	7	F#	F#	G	G#	A	A#	B	C	C#	D	D#	E	F	F#
21	8	E	E	F	F#	G	G#	A	A#	B	C	C#	D	D#	E
22	9	D	D	D#	E	F	F#	G	G#	A	A#	B	C	C#	D
23	10	B	B	C	C#	D	D#	E	F	F#	G	G#	A	A#	B
24
Sheet1

Range names:
Pitches: =Sheet1!$Q$3:$Q$14
Strings: =Sheet1!$C$14:$O$23
PedalsAndLevers: =Sheet1!$C$3:$O$11

Sub AdjustPitch(r As Range, n As Long)

    Dim m As Long
   
    With r
        m = Application.Match(.Value, Range("Pitches"), 0) + n - 1
        .Value = Application.Index(Range("Pitches"), 1 + m - 12 * Int(m / 12))
        .Interior.Color = vbYellow
    End With

End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim Strings As Range
    Dim r As Long, c As Long

    Set Strings = Range("Strings")
    Application.ScreenUpdating = False
   
    With Strings
        .FormulaR1C1 = "=INDEX(Pitches,1+MOD(MATCH(RC[-1],Pitches,),12))"
        .Columns(1).FormulaR1C1 = "=RC[-1]"
        .Value = .Value
        .Interior.Pattern = xlNone
    End With

    If Not Intersect(Range("PedalsAndLevers"), Target) Is Nothing Then
        If Target.Count = 1 Then 'Do you need to allow for multiple pedals/levers?
            r = Target.Row - Range("PedalsAndLevers").Row + 1
            c = Target.Column - Range("PedalsAndLevers").Column + 1
            Select Case r
            Case Is = 1
                Call AdjustPitch(Strings(4, c), 2)
                Call AdjustPitch(Strings(9, c), 2)
            Case Is = 2
                Call AdjustPitch(Strings(2, c), 1)
                Call AdjustPitch(Strings(5, c), 1)
            Case Is = 3
           
            Case Is = 4
           
            Case Is = 5
           
            Case Is = 6
           
            Case Is = 7
           
            Case Is = 8
           
            Case Is = 9
                Call AdjustPitch(Strings(2, c), 1)
                Call AdjustPitch(Strings(5, c), 1)
                Call AdjustPitch(Strings(3, c), -1)
                Call AdjustPitch(Strings(7, c), -1)
            End Select

        End If
    End If
    Application.ScreenUpdating = True

End Sub

 

[rvan07]

Thank you for your prompt response.

I want to say I am in awe of your expertise to do what you do with code.

Sadly, things are not working.

The Bill Jelen video 3:37-3:47 shows how to copy to clipboard and paste into new Excel worksheet. The video shows that the data along with all coloured cells in the post are transferred to the new worksheet. The video does not indicate whether the code is also transferred.

From the post I received from Stephen Crump, clicking ’Copy to Clipboard’ transfers the data only to the new worksheet. The coloured cells in the post do not transfer, nor does the code.

The identical result occurs using ’Alt + Click’.

I copied and pasted the code I received in the post into the code box below Option Explicit and then I hit Save.

There is no response when clicking any cells on the worksheet. Clicking F8 or Debug / Step Into produces a chime sound.

Troubleshooting the issue is out of my scope.

Thank you for any suggestions.

 

[StephenCrump]

Here's my workbook for download: copendent.xlsm

 

[rvan07]

Thankyou X 1000. It's a beautiful thing.

 

[rvan07]

Hello everyone, I would like to modify the existing code to do the following:
Currently, when any cell in range C3:O11 is active, it causes the linked cells in range C14:C23 to turn Yellow.
I would like to make the existing fill color of any active cell in range C3:O11 appear in the linked cells (Target Cells) in range C14:O23.
When any cell in range C3:O11 is not active, the linked cells (Target Cells) in range C14:O23 will have no fill color.
Each cell in rows 3 to 7 is linked to 2 target cells in rows 14 to 23.
So then, for example, when cell D5 is active, it would cause target cells D17, D18 to turn Green. When D6 is active, it would cause target cells D17, D21 to turn Pink.
Each cell in rows 8 to 11 is a combination of two of the rows within rows 3 to 7.
So then, for example, when cell D10 is active, it would cause target cells D17, D21 to turn Gold and cells D18, D23 to turn Yellow.

E9 Copedant VBA Coded Note Changes.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q
1
2		Fret	Open	1	2	3	4	5	6	7	8	9	10	11	12		Pitches
3	Pedal A																A
4	Pedal B																A#
5	Pedal C																B
6	Lever D																C
7	Lever F																C#
8	Pedals A+ B																D
9	Pedals B+ C																D#
10	Pedal A+ F																E
11	Pedal B + D																F
12																	F#
13	String	START	Open	1	2	3	4	5	6	7	8	9	10	11	12	String	G
14	1	F#	F#	G	G#	A	A#	B	C	C#	D	D#	E	F	F#	1	G#
15	2	D#	D#	E	F	F#	G	G#	A	A#	B	C	C#	D	D#	2
16	3	G#	G#	A	A#	B	C	C#	D	D#	E	F	F#	G	G#	3
17	4	E	E	F	F#	G	G#	A	A#	B	C	C#	D	D#	E	4
18	5	B	B	C	C#	D	D#	E	F	F#	G	G#	A	A#	B	5
19	6	G#	G#	A	A#	B	C	C#	D	D#	E	F	F#	G	G#	6
20	7	F#	F#	G	G#	A	A#	B	C	C#	D	D#	E	F	F#	7
21	8	E	E	F	F#	G	G#	A	A#	B	C	C#	D	D#	E	8
22	9	D	D	D#	E	F	F#	G	G#	A	A#	B	C	C#	D	9
23	10	B	B	C	C#	D	D#	E	F	F#	G	G#	A	A#	B	10
Changes

 

[StephenCrump]

Here's one way (again, I'll leave it to you to populate the other cases) ....

Sub AdjustPitch(r As Range, n As Long, clr As Long)

    Dim m As Long
    
    With r
        m = Application.Match(.Value, Range("Pitches"), 0) + n - 1
        .Value = Application.Index(Range("Pitches"), 1 + m - 12 * Int(m / 12))
        .Interior.Color = clr
    End With

End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    Dim Pedals As Range, Strings As Range
    Dim r As Long, c As Long, clr(1 To 5) As Long, i As Long
    
    Set Pedals = Range("PedalsAndLevers")
    Set Strings = Range("Strings")
    For i = 1 To 5
        clr(i) = Pedals(i, 1).Interior.Color
    Next i
    Application.ScreenUpdating = False
    
    With Strings
        .FormulaR1C1 = "=INDEX(Pitches,1+MOD(MATCH(RC[-1],Pitches,),12))"
        .Columns(1).FormulaR1C1 = "=RC[-1]"
        .Value = .Value
        .Interior.Pattern = xlNone
    End With
    
    If Not Intersect(Pedals, Target) Is Nothing Then
        If Target.Count = 1 Then 'Do you need to allow for multiple pedals/levers?
            r = Target.Row - Pedals.Row + 1
            c = Target.Column - Pedals.Column + 1
            Select Case r
            Case Is = 1
                Call AdjustPitch(Strings(4, c), 2, clr(r))
                Call AdjustPitch(Strings(9, c), 2, clr(r))
            Case Is = 2
                Call AdjustPitch(Strings(2, c), 1, clr(r))
                Call AdjustPitch(Strings(5, c), 1, clr(r))
            Case Is = 3
            
            Case Is = 4
            
            Case Is = 5
            
            Case Is = 6
            
            Case Is = 7
            
            Case Is = 8
            
            Case Is = 9
                Call AdjustPitch(Strings(2, c), 1, clr(2))
                Call AdjustPitch(Strings(5, c), 1, clr(2))
                Call AdjustPitch(Strings(3, c), -1, clr(5))
                Call AdjustPitch(Strings(7, c), -1, clr(5))
            End Select

        End If
    End If
    Application.ScreenUpdating = True

End Sub