Conditional Highlighting VBA based on Date - vba

I made this workbook that works sort of like a program. It takes orders, puts it in a masterlist on a separate sheet, then plots it on a calendar. Using VBA, I want my code to autohighlight the newly /modified input orders. Right now I have to double click the cell to highlight it because Excel doesn't recognize formula changes as a modification. I want to add a time range condition too - when the order is due within 14 days I want the highlight to be red, but 14 days or more is still yellow. Right now my code goes like this:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If Not Intersect(Target, Range("B9:AE53")) Is Nothing Then
For Each c In Intersect(Target, Range("B9:AE53"))
Target.Interior.Color = vbYellow
Next c
End If
End Sub
Is it doable? How do I modify my code?
Same workbook, different issue

How to do this using formulas:
1) set the cells to be in DATE format
2) write a code to show current date
3) end date - current date = number of days.
4) conditional formatting. if the number of days is greater than 14 it would be yellow, else it would turn red.
All these can be done automatically.

Related

How can I change formulas to static values after the formula has calculated the value?

I have an inventory sheet setup where a user is scanning part numbers into a sheet and a "date scanned" column will display the current date. The formula itself is working fine as it is showing the "today()" function to display the date. However, once the spreadsheet is open, the values now show today's date rather than the original scan in date (because the formula recalculates the date).
I've figured out how to change the formulas to values but I'm struggling with getting the timing right.
The below code does what is intended; it takes a look at all rows with a formula and converts them to values. The problem however, is that if a row does not have a value in it yet, just a formula, it will replace the formula with a blank.
I would like to make the code more robust and only change once a value has been determined by the formula (i.e. once a user scans in a part number). If a part number has not been scanned in, I would like the formula to stay in the column until done so by the user.
Sub makeStatic()
'
'Convert date formula to a static value
'
Dim rng As Range
For Each rng In ActiveSheet.Range("$E$2:E" & ActiveSheet.UsedRange.Rows.Count)
If rng.HasFormula Then
rng.Formula = rng.Value
End If
Next rng
End Sub
I figured this would be a combination of an if statement paired with an event handler but I haven't been able to decipher the best way to do it. Any help would be greatly appreciated.
Let me suggest a solution that gives you the result you are asking for, but in another way than you were sketching.
Let's consider your worksheet having the Part number in column A and Date scanned in column B. Both column A and B are empty, until the scanner enters the part number to column A. To react on a change in a cell in the A and end up with current date in B, you can write the following VBA function:
Option Explicit 'Excel worksheet change event for range A1 to A10
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2:A10")) Is Nothing Then
Target.Cells(1, 2).Value = Date
End If
End Sub
Of course you would change the range as needed.

How can I UPDATE a date based on a cell change in Excel?

This is a little background. In Army Aviation we have to conduct a Night Goggle (NG) flight at least once every 60 days. This date is gathered from the last time an NG flight is conducted in order to display and track currency with the mode.
With the picture linked above as reference (screenshot of actual book), I'm trying to UPDATE the date on another tab (Display Panel) with the DATE (B COLUMN) (B28) based on the INPUT (> or = 1.0) placed in the CELL (P COLUMN) (P28).
And with that, any time another NG hour entry is made below in the same column, it'll perform the script again, provided the aforementioned applies.
I've tried banging out a few VBA lines, but I'm not having any luck.
This is the shell of what I think you need which goes in the code pane associated with the sheet which you are monitoring column P of...
It fires if there is a change in column P and if the value is >=1
There is 1 further bit of logic. I am only updating C32 if the new value is greater than the existing.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim updateCell As Range
Dim lastDateCell As Range
Set updateCell = ThisWorkbook.Worksheets("Display Panel").Range("C32")
Set lastDateCell = ThisWorkbook.Worksheets("Display Panel").Range("AA32")
If Target.Column = 16 And Target.Value >= 1 Then
If Target.Offset(, -14) > updateCell Then
lastDateCell = updateCell
updateCell = Target.Offset(, -14) 'only update if greater than existing
End If
End Sub
Code in code pane of Flight Log sheet:
(Posted the solution on behalf of the question author).
Below is what I added.
Private Sub Worksheet_Change(ByVal Target As Range)
Sheets("Flight Log").Unprotect "Password Here" 'This unprotects the sheet to allow changes
Dim updateCell As Range
Dim lastDateCell As Range
Set updateCell = ThisWorkbook.Worksheets("Computations").Range("A36") 'This is the primary date location
Set lastDateCell = ThisWorkbook.Worksheets("Computations").Range("A40") 'This is the backup date location
If Target.Column = 16 And Target.Value >= 1 Then 'This check P column for the value
If Target.Offset(, -14) > updateCell Then 'If "P" returns the value, date in "B" is grabbed
lastDateCell = updateCell 'This updates the primary date cell
updateCell = Target.Offset(, -14) 'This ensures date is not overridden by lesser value
End If
End If
Sheets("Flight Log").Protect "Password Here" 'This line reprotects the sheet
End Sub
Additionally, I use two LOOKUP functions to evaluate the HOUR(s) in reference to the dates grabbed by the VBS:
=IFERROR(LOOKUP(A36,'Flight Log'!B:B,'Flight Log'!P:P),"/// NG DATE ERROR ///")
and,
=IFERROR(LOOKUP(A40,'Flight Log'!B:B,'Flight Log'!P:P),"/// NO B/U DATE ///")
after this, I use another IF function to verify the HOUR wasn't miss-entered
=IF(A37>=1,A36,IF(A41>=1,A40,"NG HOUR ERROR"))
The simple IF functions check and verify the HOUR wasn't entered incorrectly by the Pilot--which would prompt the VBS script to grab that DATE--and then re-entered to it's intended "correct" value. For instance, "Pilot enters time into block, pilots realizes time he entered was wrong, and corrects it." This will keep his error, from being an overall error.

VBA - Select Top of Matrix

I'm using a "worksheet_selectionChange" event to fire a macro whenever a cells within certain ranges are selected.
Public Sub Worksheet_SelectionChange(ByVal Target As Range)
Select Case Target.Cells.Offset(-???,0).Value
Case "LABEL_1"
Tenor = "2W"
Call MyLameMacro()
Case....
End Select
End Sub
Those ranges look like little matricies:
If the user selects any of the cells underneath label, I want VBA to lookup whatever the label is at the top. Using offset would work if I knew exactly how many rows up to Label, but its not constant....
Is there another way to go about that?
Thanks - KC
Barring further information about the layout ... you can use formatting to build your own search algorithm. This will slow down if it has to go through thousands of lines (find another way if your data set is that large).
You'll have to replace "labelColor" and "notLabel" with the background color of the label rows. This is assuming the above picture is accurate, and "Label" is highlighted. To find the value to replace them with, simply select the cell in question, then type "debug.print selection.interior.color" into the immediate window in VBA.
By placing the label value and the origin address in parentheses after your lame macro, you can preserve those values in the macro.
I did not test this. In order to do so I would have to guess at the setup of your workbook ... but an approximation of this code should work for you.
Public Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Integer
i = 0
searchLoop:
If i > 100 Then
MsgBox ("Infinite loop. Click OK to stop")
Exit Sub
End If
If Target.Offset([-i], 0).Interior.Color = labelColor Then Call MyLameMacro(Target.Offset([-i], 0), Target.address)
If Target.Offset([-i], 0).Interior.Color = notLabel Then
If Target.Offset([-i], 0).Value = "Value" Then Call MyLameMacro(Target.Offset([-i], [-1]).Value, Target.address)
i = i + 1
GoTo searchLoop
End If
End Sub

Dynamically, continously, set a cell's value according to ActiveCell's value (which is on another worksheet)

I have a workbook with a two sheets, Rep and Aux.
I want to dynamically set Aux!A2 to the value of the ActiveCell, which is on sheet Rep, but only if the ActiveCell is on column D of that sheet (in the range Rep!D2:D5000).
To top it all of I need this mechanism to run as long as the workbook is active, not just a one-shot.
For example: While being on sheet Rep I place the cursor, i.e. ActiveCell on cell D2. I expect Aux!A2 to be set to the value of Rep!D2. I move the cursor to, say, Rep!F5 and expect nothing to happen to Aux!A2, lastly, I activate cell Rep!D7 and again, expect Aux!A2 to get the ActiveCell's value. Continue till I close the workbook.
My VBA skills are non-existent and Googling, the only thing remotely close to what I described was:
Sub Macro1()
If Not Intersect(ActiveCell, Sheets("Rep").Range("D2:D5000")) Is Nothing Then Sheets("Aux").Range("A2").Value = ActiveCell.Value
End Sub
Which fails completely.
Put this in the code of the "Rep" worksheet. Triggers anytime a cell is selected on that sheet, if the cell is in column 4 (D) then it sets the value of the cell on Aux to match.
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Target.Column = 4 Then
ThisWorkbook.Worksheets("Aux").Cells(2, 1).value = Target.Value
End If
End Sub
EDIT: In response to comments.
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
End Sub
This subroutine is an event that exists on every worksheet. Any time a selection changes it will run any code you put in it. The "ByVal Target as Excel.Range" part is saying it's giving you a copy of the target range being selected, because you could select more then one cell.
If Target.Column = 4 Then
end if
This is an If Block. If the condition is true, any code between the "Then" and the "End If" will execute. The condition is if the target's column is 4 in this case.
ThisWorkbook.Worksheets("Aux").Cells(2, 1).value = Target.Value
This sets the cell at row 2 column 1 value to match the value of the target that was selected.
Now that I think about it I wonder what this code will do if you select a range of cells.....

Table Filtering drop down list Excel VBA

I am currently doing my final year project and it make use of excel VBA whereby I am bad at it. I am really hope someone could guide me through the problem that I am facing.
As for now, I am hoping that I can use a drop down list to filter my table whereby it only shows the particular department and weeks I want to show.
From the image below,
From the range("C7:L26"), whenever I filter cell(F2) or cell(J2), it will leave the data that I want from the dropdown list.
For example, if cell(F2) = 2 and cell J2 = e,
From range("C7,L26"), it will only show department with value "e" and have week 2 in it. As for cells that does not have the department value or week value, it will be cleared or blank.
I also hope that if it is possible to press a button to return the table back to default.
Do guide me and I really need your help!! Thank You
[1]http://imgur.com/GNGyh91
[2]http://imgur.com/uuh2Y1u
As for now I have this as my codes that I've learnt from a user #PeterT
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:AW28")) Is Nothing Then
Dim legendWS As Worksheet
Dim legendcell As Range
Set legendWS = ThisWorkbook.Sheets("Legend")
Set legendcell = legendWS.Range("A2:A18").Find(Target.Value)
If Not legendcell Is Nothing Then
Target.Interior.Color = legendcell.Interior.Color
End If
End If
End Sub
End Sub