PDA

View Full Version : [SOLVED] 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/eulpxh8ea2437ya/COMBINE%20BOTH%20CODES.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. :banghead: 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


B


C


D


E


F


G


H


I


J


K


L


M


N


O


P


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!!!!!:yes:clap:



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.