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.
Related
I've searched and searched the internet and all of the forums and I've been piecing together code and still can't figure this out. I've tried For loops and For Each loops and still can't get it right. In my sheet, I have all of my dates in Column D. I want to hide rows by month. I want to be able to click a macro button and only show dates in January, or February, or etc.
This is what I currently have:
Sub January()
'
'
'
Dim cell As Range
For Each cell In Range("Date")
If cell.Value = "" Then
cell.EntireRow.Hidden = False
End If
If cell.Value < "1/1/2018" Or cell.Value > "1/31/2018" Then
cell.EntireRow.Hidden = True
End If
Next cell
End Sub
When I run this, it just hides anything that isn't an empty cell. I've cycled between defining cell as a Range and as a Variant and it's the same either way.
ETA:
It is working now and it took help from everybody. I really appreciate it! Here's what I ended with..
Sub January()
'
'
'
Dim cell As Range
For Each cell In Range("Date")
If cell.Value = "" Then
cell.EntireRow.Hidden = False
ElseIf cell.Value < CDate("1/1") Or cell.Value > CDate("1/31") Then
cell.EntireRow.Hidden = True
End If
Next cell
End Sub
I removed the years from the code so that I don't have to change any coding for future years.
Your current setup would qualify all dates as either < or > the respective date comparison.
If you are trying to hide rows for January in this code, then you need to use AND instead of OR
And be sure you use >= & <= to include those first and last dates.
If cell >= "1/1/2018" AND cell <= "1/31/2018" Then
If you are trying to hide rows not January then your < and > are transposed:
If cell < "1/1/2018" OR cell > "1/31/2018" Then
Alternative approach: If you've got Excel 2013 or later, simply add a Table Slicer and filter on a MONTH column generated with =DATE(YEAR([#Date]),MONTH([#Date]),1) as shown below:
Or otherwise use a PivotTable and a Slicer:
To see how easy it is to set up a PivotTable, see VBA to copy data if multiple criteria are met
Ultimately, I believe this is the code you're looking for:
Sub January()
Dim cell As Range
Application.ScreenUpdating = False
For Each cell In Range("Date")
'If date falls on or after January 1, AND on or before January 31, don't hide the row
If cell.Value >= CDate("1/1/2018") And cell.Value <= CDate("1/31/2018") Then
cell.EntireRow.Hidden = False
Else
'If the cell doesn't contain anything or isn't in January, hide the row
cell.EntireRow.Hidden = True
End If
Next cell
Application.ScreenUpdating = True
End Sub
You need to use And logic, not Or logic. Or logic always returns TRUE unless both expressions are false or there is a null involved. Because of this, the code stopped looking at your logical statement once it evaluated to true since every date you had - I'm assuming - fell after January 1, 2018. This in turn caused the rows to hide unexpectedly.
Additionally, I would convert the strings you have into dates using CDate. It helps Excel understand what is going on a bit better and makes your code easier to understand to outsiders. Another good practice to work on is adding comments to code. I think we've all learned the hard way by leaving comments out of code at some point or another.
One last thing: if you're planning to have buttons for each month, consider doing one procedure for all of them and having variables populate the date ranges, potentially using input boxes to get the values from the user. It'll save you a lot of headaches if you ever decide to change things up in the future.
Untested, written on mobile. I am just providing an alternative approach which tries to use MONTH and YEAR. Some may find this approach easier to understand.
Option Explicit
Sub January()
Dim cell As Range
For Each cell In Range("Date")
If cell.Value = "" Then
cell.EntireRow.Hidden = False
Else
cell.EntireRow.Hidden = (Month(cell.Value) = 1) and (year(cell.Value) = 2018)
End if
Next cell
End sub
I will actually go with Slicers and Table.
But if you call VBA your neat solution then I'd say abandon the loop.
Have nothing against it but if Excel already have the functionality, then use it.
It is like a discount or a promotion that we need to take advantage of.
So instead of loop, why not just filter?
Dim lr As Long, r As Range
With Sheet1 '/* sheet where data reside */
.AutoFilterMode = False '/* reset any filtering already applied */
lr = .Range("D" & .Rows.Count).End(xlUp).Row '/* get the target cells */
Set r = .Range("D1:D" & lr) '/* explicitly set target object */
'/* filter without showing the dropdown, see the last argument set to false */
r.AutoFilter 1, ">=2/1/2018", xlAnd, "<=2/28/2018", False
End With
Above is for February of this year, you can tweak it to be dynamic.
You can create separate sub procedure for each month of you can just have a generic one.
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.
I'm trying to create a shared Excel timesheet to be used by around 30 employees for their daily timekeeping.
This timekeeping sheet will record the employees' daily timestamp for their:
Start of Pre-shift OverTime, End of Pre-shift Overtime,
Time-In, Time-Out,
Start of 1st break, End of 1st break,
Start of Lunch, End of Lunch,
Start of 2nd break, End of 2nd break,
Start of Post-shift OverTime, End of Post-shift Overtime, Etc.
I created a form interface where a specific employee could tick a CheckBox to record his/her timestamp for:
Time-In, Time-Out, Start of 1st break, End of 1st break, and so on.. The timestamp is then forwarded to a table in Sheet2 which captures all of the timestamps of that employee for the day.
My problem is: when the employee comes back to work the next day, all of the timestamps for the previous day gets overwritten by the timestamps for the present day.
An expert gave me a sample code but the data in the "time storage" sheet doesn't seem to appear horizontally in one single row. Instead, it appears in a downward diagonal pattern.
If you could help me in any way, it will be much appreciated.
Below is the sample code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngC As Range
Dim lngR As Long
Dim shtS As Worksheet
Set shtS = Worksheets("Time Storage")
If Intersect(Target, Range("B4:B12")) Is Nothing Then Exit Sub
lngR = shtS.Cells(shtS.Rows.Count, "A").End(xlUp).Row
If shtS.Cells(lngR, "A").End(xlUp).Value <> Date Then
lngR = shtS.Cells(shtS.Rows.Count, "A").End(xlUp).Row + 1
shtS.Cells(lngR, "A").Value = Date
End If
For Each rngC In Intersect(Target, Range("B4:B12"))
If rngC.Value <> "" Then
shtS.Cells(lngR, rngC.Row - 2).Value = Target.Value
End If
Next rngC
End Sub
(I enter timestamps into cells "B4:B12" of a sheet named "Time Entry", and I store them into columns B through M of a sheet named "Time Storage".
Problem is: the data in the "time storage" sheet doesn't seem to appear horizontally in one single row. Instead, it appears in a downward diagonal pattern.)
Edit: Sharing the screenshot:
"Time Entry" Sheet
"Time Sheet" Storage
It would be easier to diagnose if you included a screenshot. I'm assuming every row in Time Storage still has a date in column A and the remaining columns are filled diagonally.
The code runs on the Worksheet_Change event, which means it runs every time any cell is changed. Each individual cell being changed is causing all of the code to run, adding a single extra line with only 1 value at a time.
You should really only want the code to run once at the end when the last cell is updated. Assuming you fill the cells in order, the code should only run once when the Target range intersects with B12. So this check:
If Intersect(Target, Range("B4:B12")) Is Nothing Then Exit Sub
should be:
If Intersect(Target, Range("B12")) Is Nothing Then Exit Sub
and then the loop should run through all cells. So the rngC should be declared as a Cell instead of a Range and the loop:
For Each rngC In Intersect(Target, Range("B4:B12"))
should actually be:
For Each rngC In Range("B4:B12")
I am trying to perform an action that will see if the date in range (dateRng) is less than today's date, and then, if it is, perform the for loop to hide the rows w.here a value in the column is zero. (I am paying off loans, and every month I want it to hide any loans that have been paid off.) Months are across columns, loans are in rows. Loan balance is (i, j).
The problem is that it never exits the for loop to go back and check the date after every new 'j' (column). It just stays in the for loop. I have tried break, exit, continue, etc. None seem to work, at least where I place them. How do I get it to check for the date, compare to 'today', THEN run the for loop to check each cell in the column, before moving on to column 2, checking the date and performing the same for loop.
It would be good to have it be dynamic, but that is not necessary, as every month I could just change the ranges in the code. This is strictly for my personal use. Any help is appreciated. thank you.
Sub hidePaid()
Dim day As Range, loanRng As Range, loanSum As Worksheet, dateRng As Range, cel2 As Range, i As Long, j As Long, col As Range
Set loanSum = ThisWorkbook.Worksheets("Loan Sum")
loanSum.Activate
Set dateRng = ActiveSheet.Range("D2:R2")
Set loanRng = ActiveSheet.Range("D4:R16")
For Each day In dateRng
If day.Value < Date Then
For j = 1 To loanRng.Columns.Count
For i = 1 To loanRng.Rows.Count
If loanRng.Cells(i, j).Value < 1 Then
loanRng.Cells(i, j).EntireRow.Hidden = True
End If
Next i
Next j
End If
Next
End sub
I added comments in the code to show my changes.
You were close, but had one to many loops and like you say, needed to find the right place for the exit.
Sub hidePaid()
Dim day As Range
Dim loanRng As Range
Dim loanSum As Worksheet
Dim dateRng As Range
Dim i As Long
Set loanSum = ThisWorkbook.Worksheets("Loan Sum")
loanSum.Activate
Set dateRng = ActiveSheet.Range("D2:R2")
Set loanRng = ActiveSheet.Range("D4:R16")
'This loop processes by column
For Each day In dateRng
'Once the date in the column is greater than today, it will stop processing
'It assumes the values in dateRng are valid dates
'(I.e. '01/01/2016' not just 'Jan', you can use number format in Excel to
'get a date to show as 'Jan' if that is better for you)
If DateDiff("d", Now(), day.Value) > 0 Then Exit For
'The line of code you had should have worked in sense,
'it would have touched every column but only procesed those before today
'It also assumes that value in the cell to be an actual date
'If day.Value < Date Then
'You do not need a column loop here as you are already in one in the
'previous loop
'For j = 1 To loanRng.Columns.Count
'This loop processes all the rows that are not already hidden and if
'the value is equal to 0 then it hides the row
'Note: you had the check to be less than 1, .50 is less than 1 and you don't
'want to get caught out on a loan!
For i = 1 To loanRng.Rows.Count
If (loanRng.Cells(i, day.Column - 3).Value = 0) And (loanRng.Cells(i, day.Column - 3).EntireRow.Hidden = False) Then
loanRng.Cells(i, day.Column - 3).EntireRow.Hidden = True
End If
Next i
Next
'Its good practice to clear out resources when finishing
Set dateRng = Nothing
Set loanRng = Nothing
Set loanSum = Nothing
End Sub
I am writing my first macro and have a question on how I can select a specific Row based on a value in a specific column. here is my code so far:
Sub Pipeline()
'Module 3
'Iterating through the Funding Date Column and looking for clients going live within 30 days
'Selecting the rows for each client in that target range
'TODO: Export information into an email template in Outlook
'TODO: Send email to distribution list
Dim fundingDate As range
Set fundingDate = range("M4:M500")
Dim todaysDate As Date
todaysDate = Date
For Each cell In fundingDate
If cell < todaysDate + 30 Then
'Need to select the entire row
Else
cell.Font.ColorIndex = 3
End If
Next
End Sub
replace 'Need to select the entire row with
cell.entirerow.select
UPDATE
Here is a much more efficient way to get what you need without all the looping.
In your code Replace from For Each cell ... to Next with this:
With fundingDate
.AutoFilter 1, "<" & todaysDate + 30
.SpecialCells(xlCellTypeVisible).Select
'here are your clients going live in next 30 days
.AutoFilterMode = False
End With
You may need to provide some error checking in case you don't have clients going live within 30 days (SpecialCells method will fail on this) and also, if M4 is not your column header, you may want to adjust how the range picks up the visible cells.