PDA

View Full Version : [SOLVED] Need help with eisting event code to in regards to recording row of active color cell



estatefinds
06-15-2018, 10:07 AM
I have an event code that colors the interior cells in yellow based on the
Combination selected,
These actively colored cells are colored; there are 5 at a time in the
Range H5 to L27

Once I select each combination for example you’ll see that the numbers that have no interior color will be colored in yellow 5 at a time.
Now there is a range of data Q 5 to U 27 same color pattern unfilled and
The ones filled in red. The range is starting at Q 5 to Q 27, R 5 to R 2, S 5 to S 27 , T 5 to T 27, U 5 to U 27 .
These are the numbers I want to call for example in
Q5 will be labeled row 1, R 11 is Row 7 and so on.

So Every time I select a number for example in column A the combination 1-2-3-7-9 the numbers in the range H 5 to H 27 will be colored in yellow.

What I’m trying to get help on is a macro that will also color the interior of the cells of the same location, For example:

So you can see the 5 cells in the range H5 to H 27 are colored in yellow and the corresponding range to the right in range Q 5 to Q 27 are colored in yellow in the same cells but when the cells in the range Q 5 to Q 27 are colored in yellow the row number that is in the cells that is colored yellow will be recorded in the column W starting at W 11 for example 1-5-7-12-18.

The length of the range will change so it needs to be able to run on any length.
Any help on this is much appreciated!
Thank you!!!


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

estatefinds
06-16-2018, 01:25 PM
I had to remove the code from the file as it the file size was too big to send. the event code needs to be added to blank worksheet then copy and paste the data in the file I attached.

The event code works when I select a combination in column A, each individual number found in the uncolored cells of the range in H5 to L27 the backgound or interior color of those cells are colored yellow.

now the help I am requesting is how can i get the areas in the Range Q5 to U27 in the areas that are uncolored be colored in yellow in the identical areas of the the range to right as in the range to the left.

I had colored the interior of the cells to show what I mean as an example and once the range in the right is colored the row number in the range Q5 to U27 will be recorded,


in other words where ever the yellow appears in regards to locations on the first range it will be mimicked on the second range to the right and where ever the 5 yellows appear the row that is labelled in the cell be will be recoreded in the the coliumn W starting at 11. as shown in the file as an example.

Any help on this is apprecaited. Thank you Sincerely,

Dennis

estatefinds
06-19-2018, 05:33 PM
Is there a way to incoprate the code below into the above code so it works as one Event code? as i know there can only be one event code at a time in a worksheet.

this will hopefully get me closer to what im looking for in the original.

the code below when the first range of data is highlighted in yellow the data is highlighted in the second range in the exact same cells.








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:V")) 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