How to Find selected Active cell highlighted with Color and copy the data provided in the cell above to some special assigned cell - vba

Question

I am new to VBA so if somebody help me to solve my problem then I shall be really grateful as I am stuck with it.
enter image description here
Please have a look at the attached picture below and if somebody provide me code for VBA then it will be really helpful for me. Task contains following steps.
1- In row 11 dates are provided in corresponding columns. Like 16/11, 17/11, 18/11 etc.
2- From row (12 to 29) I have different tasks to do are provided.
My task is.
1- When I select any cell/ box by filling it with any color the date available in the (row 10) above that cell (automatically goes/copies) to the specified cell mentioned for that task.
For Example: I select Row 21 AQR presentation cell and highlight it by filling it with color so the date above that cell automatically goes/copies to specified cell mentioned above for AQR presentation and similarly I have to do with every cell.
Request:
I need a code that detects the active cell which is highlighted and sends the date above that cell to a specified folder mentioned for that above.
Please see the figure for more clear understanding.
I shall be grateful if somebody help me in providing the code for this.

Answer 1

I do not believe that an exact match on your requirement is possible; certainly I do not know how to provide an exact match. However, I believe something very similar is possible which I think is more convenient than your request.
You need to use event routines. Excel identifies “Open workbook”, “Activate worksheet”, “Change selection” and many others as events. For any Excel event, you can write a routine in VBA which Excel will execute when that event occurs.
If you open Excel’s VB Editor and click F2 you get a list of all the classes and their members. Scroll down the Classes list until you reach “Worksheet”. The list on the right will display all member of the Worksheet class. Those with a lightning symbol against them are events: Activate, BeforeDelete, BeforeDoubleClick, BeforeRightClick, Calculate and so on. If you type “excel vba worksheet before double click event” into your favourite search engine, you will get web pages that explain the event and usually give an example of a routine for the event. I find the documentation a little vague and I usually have to experiment with an unfamiliar event.
I have written event routines for the WorkBook Open event and the Worksheet Activate, Before Right Click and Selection Change events. Unfortunately, there is no “Worksheet Change Cell Colour” event so I have used the “Worksheet Before Right Click” event instead.
With the VB Editor open, you will see the Project explorer down the left hand side. If you cannot see it, click Ctrl+R. What you will see will be something like:
- VBAProject(Xxxxx.xlsm)
- Microsoft Excel Objects
Sheet1 (Kick off)
Sheet2 (Sheet2)
ThisWorkbook
You will have more worksheets, perhaps some user forms and some modules but they do not matter for the moment. If you can see a plus where I have shown a minus, click it to expand the list. I have created a copy of your kick-off worksheet which I have named “Kick off”. You probably have a different name but I will call it “Kick off”. Click “Sheet1 (Kick off)” and a white area will appear to the right. This is a code area reserved for this worksheet. There is a similar code area for every worksheet. If you click “ThisWorkbook”, you will get another code area. You can use this code area as an ordinary module but I advise against it. This code area should be reserved for certain workbook level routines.
Place this code within the ThisWorkbook code area:
Option Explicit
Sub Workbook_Open()
If ActiveSheet.Name = "Kick off" Then
Worksheets("Sheet1").Activate
Worksheets("Kick off").Activate
End If
End Sub
A routine with the name Workbook_Open in this code area will be automatically executed when the workbook is opened. Replace “Kick off” with your name for this worksheet and replace “Sheet1” with the name of any of your other worksheets.
If worksheet “Kick off” was active when the workbook was saved, its Activate routine is not executed automatically when the workbook is opened. The sole purpose of this code is to force execution of the “kick off” activate routine.
The code below all belongs in the code area for Worksheet “Kick off”. This code will not do exactly what you want so I will attempt to explain it in sufficient detail for you to adapt it to your requirements,
My code starts with some constants for rows and columns. For example:
Const RowDate As Long = 11 ' Row holding dates
Currently, you have your dates in row 11 but this could easily change as you develop your system. If you amend your worksheet so row 13 holds the dates, simply update this constant statement and your code is fully updated. So much easier than scanning your code for all uses of the literal 11.
Next I have some constants for colours. If you do not like my colours, amend these constant statements.
Next are some Dim statements. A variable declared within a routine, is destroyed when the routine exits. A variable declared outside a routine has a longer life. I do not know if these variables last until the workbook is closed or until another worksheet is activated. It does not matter; they last long enough to allow me to pass values from one call of an event routine to another call.
Next is Private Sub Worksheet_Activate(). If your users switch to another worksheet, this routine will be called automatically when they switch back. It records the position of the active cell and loads three arrays. The three arrays and their values are:
Array entries -> 0 1
RowActionSrc 16 21
RowActionDest 2 3
ColActionDest 25 25
The way these arrays are used is a common technique with experienced programmers but might be new to you. You want special actions to occur if a selection is made on row 16 or 21. These rows may change and similar actions may be required for other rows later. By having a single statement load these row numbers into an array, it is easy to change them or add to them. If a cell on row 16 is selected, you want its date copied to row 2, column 25. If a cell on row 21 is selected, you want its date copied to row 3, column 25. These destinations may not be what you want but they are easy to change so that does not matter. I have coded Worksheet_BeforeRightClick to use the numbers in these arrays to move the required dates to the required cells.
Stepping over Worksheet_BeforeRightClick for the moment, the last routine in this code is Worksheet_SelectionChange. I was not sure if this was a good idea. The functionality provided by this routine is the cause of most of the complexity in this code. I have decided to keep the functionality because I believe it is helpful and because it gives a very good demonstration of what event routines can do. This is an image of my kick off worksheet:
It is a little small but adequate for the purpose and does not exactly match yours but is close enough. The active cell is currently cell Z21. You will notice the task and date for this cell are coloured. When I first started, I found it difficult to match the active cell to its task and date. Colouring the task and the date made it much easier. This is what Worksheet_SelectionChange does. When the user moves the active cell, this routine is called automatically to remove the colouring from the old task and date and colour the new task and date. As I said, I believe this functionality is both helpful and a good demonstration of how you can use event routines to tailor the Excel experience.
Returning to Worksheet_BeforeRightClick; this is the routine that provides the functionality that is the closest match I can achieve to what you requested. As I said, there is no event based on colouring a cell. Even if there was, I am not sure I would find it convenient. I would have to select the Home tag then Fill Colour then the colour I wanted before the event would be triggered. With the Before Right Click event, I select the cell I wish to be active using the arrow keys or the mouse or F5 or however I wish. I then click the right mouse key. The event routine colours the cell with the standard colour and copies the date.
Experiment with my code. Try to work out how it achieves its objectives. Come back with questions as necessary but the more you can work out for yourself, the quicker you will develop your own skills.
Option Explicit
' I define these column and row numbers as constants in case they change.
' If they do change, one amendment here and the code is updated. If the
' literal is used in the code, you have to search for and fix every use
' to update the code.
Const ColDateFirst As Long = 3 ' The first column with a date
Const ColTaskName As Long = 1 ' Column holding task names
Const RowDate As Long = 11 ' Row holding dates
Const RowTaskFirst As Long = 12 ' First row containing tasks
' Warning: If you change any of these colours, the values are BBGGRR which
' is Excel's standard and not RRGGB which is everyone else's standard.
Const ClrCrntHeader As Long = &H99CCFF ' Tan
Const ClrSelectedCell As Long = &HFFFF& ' Yellow
' The position of the active cell is recorded in these variable so
' when the active cell changes the old position is known. This is
' necessary to correctly maintain the row and column headers. If
' the row and column headers were not highlighted, these variables
' would not be needed.
Dim ColPrev As Long
Dim RowPrev As Long
' These arrays are loaded by Worksheet_Activate(). See that routine
' for an explanation of these arrays.
Dim RowActionSrc() As Variant
Dim RowActionDest() As Variant
Dim ColActionDest() As Variant
Private Sub Worksheet_Activate()
' This routine is called when the worksheet is activated (selected)
' * If the active cell is within the monitored area, the header row and
' column will already be hightlighted. Record the current position of
' the active cell in ColPrev and RowPrev.
' * Load RowAction and ColAction arrays
' * The monitored area is ColDatFirst and right and RowTaskFirst amd down.
Application.EnableEvents = False
If ActiveCell.Row >= RowTaskFirst And ActiveCell.Column >= ColDateFirst Then
' Active cell was within the monitored area when the workbook was closed or
' the user switched to another worksheet. The appropriate row and column
' headers will still be highlighted.
ColPrev = ActiveCell.Column
RowPrev = ActiveCell.Row
Else
' The active cell was outside the monitored area. No row or column header
' is highlighted
ColPrev = 0
RowPrev = 0
End If
' If the active cell is right clicked when it is in one of the rows
' listed in RowActionSrc:
' 1) The active cell is coloured ClrSelectedCell
' 2) The date above the active cell is copied to the row and column
' specified in the cell specified by the matching positions
' in RowActionDest and ColActionDest.
RowActionSrc = VBA.Array(16, 21)
RowActionDest = VBA.Array(2, 3)
ColActionDest = VBA.Array(25, 25)
' For example:
' * If cell(16,20) is right clicked, the date in cell(11, 20) is copied
' to cell(2,25).
' * If cell(21,27) is right clicked, the date in cell(11, 27) is copied
' to cell(3,25).
Application.EnableEvents = True
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
' * The active cell has been right clicked.
' * If the active cell is within the monitored area and if active row is
' specified in RowActionSrc, copy the data above the active cell to the
' specified destination cell.
Dim CellColoured As Range
Application.EnableEvents = False
Dim InxC As Long
If ActiveCell.Row >= RowTaskFirst And ActiveCell.Column >= ColDateFirst Then
' Active cell was within the monitored area
For InxC = 0 To UBound(RowActionSrc)
If RowActionSrc(InxC) = ActiveCell.Row Then
' The active cell is in a row for which the date above it is to be
' copied to a specified destination. In addition, the active cell is
' to be coloured
' First remove colour from any previously selected cell
Application.FindFormat.Interior.Color = ClrSelectedCell
Do While True
' What:="*" will only match cells with a value
' What:="" will match cells with or without a value
Set CellColoured = Rows(ActiveCell.Row).Find(What:="", SearchFormat:=True)
If CellColoured Is Nothing Then
Exit Do
End If
CellColoured.Interior.ColorIndex = xlNone ' Remove colour
CellColoured.Value = "" ' Remove value if any
Loop
' Colour selected cell
Cells(ActiveCell.Row, ActiveCell.Column).Interior.Color = ClrSelectedCell
' Move date for active column to specified cell
Cells(RowActionDest(InxC), ColActionDest(InxC)).Value = Cells(RowDate, ActiveCell.Column).Value
End If
Next
End If
Cancel = True ' Surpress default action for Right Click
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
' A new cell has been selected; that is, there is a new active cell.
If ColPrev <> 0 Then
' Remove highlighting from previous task name and date
Cells(RowPrev, ColTaskName).Interior.ColorIndex = xlNone
Cells(RowDate, ColPrev).Interior.ColorIndex = xlNone
End If
If ActiveCell.Row >= RowTaskFirst And ActiveCell.Column >= ColDateFirst Then
' Active cell is within the monitored area
ColPrev = ActiveCell.Column
RowPrev = ActiveCell.Row
' Highlight task name and date
Cells(RowPrev, ColTaskName).Interior.Color = ClrCrntHeader
Cells(RowDate, ColPrev).Interior.Color = ClrCrntHeader
Else
ColPrev = 0 ' No previous active cell
RowPrev = 0
End If
Application.EnableEvents = True
End Sub
Explanation of additional functionality
The original code would colour a cell selected with a right click but would not remove the colour from a previously selected cell. The new code locates any cells in the active row coloured ClrSelectedCell (= Yellow = &HFFFF&) and removes the colour and the value if any.
Find is normally used to search for values but it is possible to search for formats. If there is any decent documentation on the format search functionality, I have failed to find it. The extra code has been developed through experimentation rather than by following official instructions. This code has been tested using Excel 2016 but I have no reason to believe it will not work with earlier versions.
The changes are the inclusion of a new variable (Dim CellColoured As Range) and the inclusion of this code just before the newly selected cell is coloured:
Application.FindFormat.Interior.Color = ClrSelectedCell
Do While True
' What:="*" will only match cells with a value
' What:="" will match cells with or without a value
Set CellColoured = Rows(ActiveCell.Row).Find(What:="", SearchFormat:=True)
If CellColoured Is Nothing Then
Exit Do
End If
CellColoured.Interior.ColorIndex = xlNone ' Remove colour
CellColoured.Value = "" ' Remove value if any
Loop
There should only be one previously coloured cell but this code loops so all previously coloured cells are cleared of colour and value.
Note: I clear the colour using ColorIndex = xlNone rather than Colour = vbWhite. If you set the colour of a cell to white, you lose the borders but you do not if you set the colour index to none.

Answer 2

Define a function in VBA:
Function NOTWHITE(rng As Range) As Boolean
Application.Volatile
If rng.Interior.ColorIndex = xlNone Or rng.Interior.Color = vbWhite Then
NOTWHITE = False
Else
NOTWHITE = True
End If
End Function
Then put into D12 the following formula and copy-paste to all other cells you wish to behave like that:
=IF(NOTWHITE(D12); D$11; "")
However you need to recalculate the sheet by F9 after each change.