NEED HELP MODIFYING EXISTING EVENT CODE BY ADDING ANOTHER CODE RUN AS ONE CODE.

**estatefinds** · 07-14-2018, 03:59 PM

https://www.dropbox.com/s/eulpxh8ea2...ODES.xlsm?dl=0

Sub test()    Dim keyCell As Range    Dim SearchRange As Range
    Dim writeCell As Range, oneCell
    Dim Numerals As Variant, i As Long
    
    If Selection.Column <> 1 Then Beep: Exit Sub
    
    Set keyCell = Selection.Cells(1, 1)
    Numerals = Split(CStr(keyCell.Value), "-")
    With keyCell
        Set SearchRange = Range(.Cells(2, 1), .EntireColumn.Cells(Rows.Count, 1).End(xlUp))
    End With
    SearchRange.Offset(0, 1).Resize(, 5).ClearContents
    
    For i = 0 To UBound(Numerals)
        Set writeCell = Nothing
        For Each oneCell In SearchRange
            If IsNumeric(Application.Match(Numerals(i), Split(oneCell.Value, "-"), 0)) Then
                Set writeCell = oneCell
                Exit For
            End If
        Next oneCell
        
        If Not writeCell Is Nothing Then
            With writeCell
                .Offset(0, Application.Match(Numerals(i), Split(.Value, "-"), 0)).Value = writeCell.Row - keyCell.Row
            End With
        End If
    Next i

End Sub

This code above works when a combination of 5 numbers in a Cell is selected in column A, then individual numbers in the range H5 to L27 that make up the combination will be colored yellow in the cell interior.

[Private Sub Worksheet_SelectionChange(ByVal Target As Range) With Target
If .Cells.Count = 1 Then
If Not Application.Intersect(Target, Range("H:L")) Is Nothing Then
Application.EnableEvents = False
Application.Union(.Cells(1, 1), .Offset(0, 9)).Select
Application.EnableEvents = True
End If
If Not Application.Intersect(Target, Range("Q:U")) Is Nothing Then
Application.EnableEvents = False
Application.Union(.Cells(1, 1), .Offset(0, -9)).Select
Application.EnableEvents = True
End If
If Not Application.Intersect(Target, Range("Z:AD")) Is Nothing Then
Application.EnableEvents = False
Application.Union(.Cells(1, 1), .Offset(0, -9)).Select
Application.EnableEvents = True

End If
End If
End With

End Sub]

This code directly above this description works when I place a cursor on a cell within the range range H5 to L27 where ever cell the cursor rests, it will also rest on the same cell in a duplication of the range Q5 to U27 . for example when I place cursor on the H5 the cursor will show also on the Q5.

I need help in regards to adding the code just above to work with 5 simultaneous cells, so when I run the code that appears at the top the following is what i need to happen,

When I select a combination in column A, the cells interior color of 5 individual numbers that make up the selected combination, that are found in the Range H5 to L27 will be colored yellow in the cell interior.
so I need the data in the range Q5 to U27 to be interior colored yellow in the same cells ,

( what is done in one range H5 to L27, is done to the other range Q5 to U27).

The data in the Range Q5 to U27 within the cells has no involvment. Just the cells that are being colored interior cells yellow as in the first range H5 to L27.

I know 2 event codes cannot work in the same worksheet so I need help modifying the immediate code just above to work with 5 simulataneous cells and be added to the very top code to work as one event code.

Please!! Thank you

**Logit** · 07-14-2018, 07:49 PM

.
Does this work for you ?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column <> 1 Then Exit Sub
    Application.EnableEvents = False
    Call Test2(Target)
    Call Test3(Target)
    Application.EnableEvents = True
End Sub
 
 
Sub Test2(Target As Range)
    Dim r As Range, arr, a
     
     
    Set r = Range("H:L").SpecialCells(2)
    For Each cel In r
        If cel.Interior.ColorIndex = 6 Then
            cel.Interior.ColorIndex = xlNone
        End If
    Next
    arr = Split(Target, "-")
    For Each a In arr
        Call DoFind(r, a)
    Next
     
     
End Sub
 
 
Sub DoFind(r, v)
    With r
        Set c = .Find(v, Lookat:=xlWhole)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                If c.Interior.ColorIndex = xlNone Then c.Interior.ColorIndex = 6
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
End Sub


Sub Test3(Target As Range)
    Dim r As Range, arr, a
     
     
    Set r = Range("Q:U").SpecialCells(2)
    For Each cel In r
        If cel.Interior.ColorIndex = 6 Then
            cel.Interior.ColorIndex = xlNone
        End If
    Next
    arr = Split(Target, "-")
    For Each a In arr
        Call DoFind(r, a)
    Next
End Sub

**estatefinds** · 07-14-2018, 08:22 PM

you have the right idea, but if you look at the original file that I had provided the link to the drop box, you will see it only utilizes the numbers that are remaining, for example the uncolored cells. the cells that are interior colored red are ignored. I had attached a link cause the file may have been to big and would allow me to upload.

Thank you! take look a look and let me know

Also the numbers that get interior colored yellow in the range H5 to L27 are the ones that match the the numbers of the combination in Column A,

I see that the data in the second range the Q5 to U27 is being colored; the interior of the cell yellow cause it sees the numbers that seen in the first range H5 to L27. this isnt what it should be doing , it should be just coloring the interior cells yellow in the same cell row and column that it is coloring in the first range. without any regard to the data in the cell.

For example when the H5 is colored cell interior yellow and the and the H9 cell colored interior yellow, and the I11 is cell colored interior yellow, and the H16 colored cell interior, and the H22 is colored cell interior yellow,

Then in the second range the folowing are colored yellow cell interior Q5 then Q9, then R11 , then Q16, then Q22 would be colored interior cell yellow.

its like using a Caliper, what is marked off in one spot on the paper is marked on the same paper a little further over on the same paper but at a set distance from the original spot.

**Logit** · 07-14-2018, 08:52 PM

.
Help me understand.

How do the red colored cells become red ? Did I miss that in the code you provided ?

And in the Columns Q:U you only want the non-colored cells to be colored yellow ? Do they need to stay yellow or what ?

**estatefinds** · 07-14-2018, 09:39 PM

The red ones I do manually, no worries there. Yes only the uncolored ones. They only stay yellow until I move to the next combination in column A.

**Logit** · 07-15-2018, 07:48 AM

.
Ok.

I thought the red colored cells were something you were experimenting with ... that is why I deleted the red color. Prior to doing so, when running the macro, the yellow
did not "bleed through" or change the red color. So ... if you simply place the red color back in the cells it should run as desired. If not, come back ...

**estatefinds** · 07-15-2018, 08:34 AM

So i add the red back and the first part does what it supposed to, meaning I select the combination in column A and it colors the interior cell yellow the numbers that make up that combination. Now The far right range Q5 to U27 is colored red exactly as the range H5 to L27. I need the cells that are colored interior cell yellow in the positions of the cells in the first range are colored interior cell yellow.

The data that is in the cells in the range Q5 to U27can be deleted to avoid confusion.
So whatever cell gets colored interior cell yellow in the first range H5 to L27, the cells in the Q5 to U27 wil be colored cell interior yellow.

So for a visual only only if I got a transparent copy of the first range and placed it over the second range the colored cells interior yellow would be in the same cells.

**Logit** · 07-15-2018, 08:59 AM

.
Sorry .. you've lost me completely.

Can you make a "before" and "after" visual representation of what you are saying ? Maybe that will help.

So you understand my confusion ... it sounds like you are contradicting yourself with the descriptions. In my mind, it sounds like you are saying the red colored cells are no bother ... " I'll just leave them there in the Q:U table and
I only need to concentrate on the cells that aren't red. As they become yellow I'll note that and move on." Then it sounds like you are saying ... "The red cells need to change to yellow if the number is involved in the selection from
the left table."

My description, now that I read it, sounds as confusing as I am of yours.

Hopefully you understand ?

**estatefinds** · 07-15-2018, 09:09 AM

sorry for the cinfusion,
I am attaching what it should look like. so the reds dont change the only ones being colored are the white cells the uncolored ones. so I had sent thhe file how it should look

**Logit** · 07-15-2018, 09:19 AM

.
In your attached sample .... that is precisely what I understood you were attempting to achieve.

So if you take my sample in Post #2 ... add back in the red where you want it. Isn't that the same as what you've just
provided in this sample ?

**estatefinds** · 07-15-2018, 09:32 AM

yes but when i run it, I select the column A first combination and it colors cell interior yellow, the number that make up that combination. then you have it so it colors all cells whose numbers in the range Q5 to U27 match the numbers in the H5 to L27, but should only color cell interior yellow the identical place it is colored in the range H5 to L27 . so all i need is ,

think of it this way what my left hand is doing in the range in regards to coloring interior cell , The right hand irregardles of the data in the cells in the range Q5 to U27 is placing the color interior yellow in the same location as it is in range h5 to L27

so the range Q5 to U27 is only copying the cells that are being colored yellow in the first range H5 to L27. just the location of what being colored.

Thhink of it as the second range is a location on a map, the
Range Q5 to U27 is only coloring cell interior yellow the same map location in the range as te Range H5 to L27.

The first rane that gets colored cell interior depends on the data selected in the Column A

The second range is dependant upon where in the range of cells were colored yellow and hence the same cells location in the second range get colored interior cell yellow. hence copy catting where the cells are being colored in the first range will be copied in the scond range.

**Logit** · 07-15-2018, 09:52 AM

.
How about this ?

Excel 2007 32 bit

	A	H	I	J	K	L	Q	R	S	T	U
1	1-2-3-7-9	1	4	8	25	31	1	1	1	1	1
2		13	17	25	29	34	2	2	2	2	2
3		11	14	19	26	30	3	3	3	3	3
4		8	10	13	14	27	4	4	4	4	4
5		3	13	14	20	32	5	5	5	5	5
6		10	14	18	21	30	6	6	6	6	6
7		4	9	16	21	31	7	7	7	7	7
8		8	11	25	28	35	8	8	8	8	8
9		10	19	27	33	35	9	9	9	9	9
10		1	11	13	24	29	10	10	10	10	10
11		19	20	25	31	32	11	11	11	11	11
12		2	13	14	17	28	12	12	12	12	12
13		3	17	24	25	29	13	13	13	13	13
14		6	13	20	31	32	14	14	14	14	14
15		2	4	8	21	30	15	15	15	15	15
16		12	15	20	22	28	16	16	16	16	16
17		1	15	19	27	34	17	17	17	17	17
18		7	14	22	28	29	18	18	18	18	18
19		3	20	32	33	34	19	19	19	19	19
20		10	24	27	28	32	20	20	20	20	20
21		5	12	15	22	29	21	21	21	21	21
22		2	9	18	29	33	22	22	22	22	22
23		1	14	18	23	27	23	23	23	23	23
24
25
26
27	4-5-6-7-9	1	4	8	25	31	1	1	1	1	1
28		13	17	25	29	34	2	2	2	2	2
29		11	14	19	26	30	3	3	3	3	3
30		8	10	13	14	27	4	4	4	4	4
31		3	13	14	20	32	5	5	5	5	5
32		10	14	18	21	30	6	6	6	6	6
33		4	9	16	21	31	7	7	7	7	7
34		8	11	25	28	35	8	8	8	8	8
35		10	19	27	33	35	9	9	9	9	9
36		1	11	13	24	29	10	10	10	10	10
37		19	20	25	31	32	11	11	11	11	11
38		2	13	14	17	28	12	12	12	12	12
39		3	17	24	25	29	13	13	13	13	13
40		6	13	20	31	32	14	14	14	14	14
41		2	4	8	21	30	15	15	15	15	15
42		12	15	20	22	28	16	16	16	16	16
43		1	15	19	27	34	17	17	17	17	17
44		7	14	22	28	29	18	18	18	18	18
45		3	20	32	33	34	19	19	19	19	19
46		10	24	27	28	32	20	20	20	20	20
47		5	12	15	22	29	21	21	21	21	21
48		2	9	18	29	33	22	22	22	22	22
49		1	14	18	23	27	23	23	23	23	23

Sheet: Sheet3

**estatefinds** · 07-15-2018, 10:07 AM

the yellow should be colored in the the same location in the range so the yellow colored interior cells will be identical in regards to cell adress on each range
the way you have it now, the range 1 doesnt match range 2 in relation to where the cells are colored.

okay remove all the numbers in the second range of what you did above. then remove the the color of the yellow cells in the second range. then look at first range

ok look at the one you submitted directly above the colored interior yellow is in the first range on the left > I27 I33 H40 H44 H47 now the second range should be colored interior cell yelow at t R27 R33 Q40 Q44 Q47

**Logit** · 07-15-2018, 07:26 PM

.
This code works here :

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column <> 1 Then Exit Sub
    Application.EnableEvents = False
    Call Test2(Target)
    
    Application.EnableEvents = True
End Sub
 
 
Sub Test2(Target As Range)
    Dim R As Range, arr, a
    Dim cel As Variant
     
    Set R = Range("Q:U").SpecialCells(2)
    For Each cel In R
        If cel.Interior.ColorIndex = 6 Then
            cel.Interior.ColorIndex = xlNone
        End If
    Next
    
    Set R = Nothing
    
    Set R = Range("H:L").SpecialCells(2)
    For Each cel In R
        If cel.Interior.ColorIndex = 6 Then
            cel.Interior.ColorIndex = xlNone
        End If
    Next
    'Range("Q:U").Interior.ColorIndex = xlNone
    arr = Split(Target, "-")
    For Each a In arr
        Call DoFind(R, a)
    Next
   
End Sub


Sub DoFind(R, v)
Dim c, firstAddress
Dim Target As Range


    With R
        Set c = .Find(v, Lookat:=xlWhole)
        
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                If c.Interior.ColorIndex = xlNone Then c.Interior.ColorIndex = 6
                   
                If c.Interior.ColorIndex = 6 Then
                    If c.Offset(0, 9).Interior.ColorIndex = xlNone Then
                        c.Offset(0, 9).Interior.ColorIndex = 6
                    End If
                End If
                
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
    
End Sub

Keep in mind, in my version of the workbook, both tables H:L & Q:U start on the same row ( #5 ) and end on the same row ( #27 ). With the code seen above, the tables will need to remain in those locations OR
the code will need to be changed.

**estatefinds** · 07-16-2018, 03:37 AM

It works Great!!!! Thank you Very much!!!!!

now if I were to start at row 5 and change the last row to instead of 27 and go to more data to about row 70 what would I need to change in the code?

**Logit** · 07-16-2018, 06:40 AM

.
So long as the Columns remain H:L and Q:U you will be ok.

If you change the column locations, then the reference to the columns in the code must change as well.

**estatefinds** · 07-16-2018, 07:56 AM

Awsome!!! Great job on this!!!!!�� thank you again!!!!

**Logit** · 07-16-2018, 08:01 AM

.
You are welcome.

Thread: NEED HELP MODIFYING EXISTING EVENT CODE BY ADDING ANOTHER CODE RUN AS ONE CODE.

Thread Tools

Display

NEED HELP MODIFYING EXISTING EVENT CODE BY ADDING ANOTHER CODE RUN AS ONE CODE.

Posting Permissions