I was given a roster in a worksheet with Monday starting in C1 going to Sunday in AG1, then Monday + 7 starting in C30. This number is changeable depending on staff members.
I want to achieve that by clicking a button on a different worksheet, it takes the date out of B2 (which should be a Monday - achieved error message), finds that date (I can do so in excel, not sure in VBA) and hides all rows beforehand.
I'm aware of grouping and can apply grouping (for the first instance). What makes my scenario more complicated is that the roster is already grouped (for printing purposes) which I can't/ don't want to lose.
How can I help it, that it doesn't delete any first instance grouping.
It also doesn't go to the roster worksheet (yet), but groups on the worksheet the button is on.
Private Sub CommandButton3_Click()
'check if date is a Monday
If Weekday(Range("B2").Value) <> 2 Then
MsgBox "Please alter the date to a Monday.", 0, "Date selected is not a Monday."
Exit Sub
End If
'find row
Dim Hrange As String
Hrange = "1:" & Range("C41").Value
Sheets("Roster2023").Activiate 'doesn't go to roster
Rows(Hrange).Group
'MsgBox Hrange
ActiveSheet.Outline.ShowLevels RowLevels:=8, ColumnLevels:=8
'MsgBox Hrange
End Sub
Related
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.
I have a Macro that takes data out of 2 reports.
in the second report I have dates that I copy. I need to take a date and subtract from it 14 days
I go to first blank cell in column D, then I want to calculate the formula in column C and scroll down without type how many cells (because it is a macro to a daily basis and the amount of data will change). I want to do this until the end of the data I copied.
In the end I want to copy it as values to column B.
Here is what I have in my code(part of all macro):
'first we go to the buttom of the column
'for NOW - change manually the top of the range you paste to
'Now, paste to OP_wb workbook:
OP_wb.Sheets("Optic Main").Range("D1").End(xlDown).Offset(1, 0).PasteSpecial
Paste:=xlPasteValues
' Calculate Due Date to MFG tools
' it means date we copied from MFG daily minus 14 days
_wb.Sheets("Optic Main").Activate
Range("C1").End(xlDown).Offset(1, 0).Activate
ActiveCell.FormulaR1C1 = "=RC[1]-14"enter code here
You need to loop from the first row to the last row. In general, there are plenty of good ways to define the last row of a given column. Once you have done it, replace the value of lngEndRow and run the following code:
Option Explicit
Public Sub TestMe()
Dim lngStartRow As Long: lngStartRow = 1
Dim lngEndRow As Long: lngEndRow = 100
Dim rngMyRange As Range
Dim rngMyCell As Range
With ActiveSheet
Set rngMyRange = .Range(.Cells(lngStartRow, 5), .Cells(lngEndRow, 5))
End With
For Each rngMyCell In rngMyRange
rngMyCell.FormulaR1C1 = "=RC[1]-14"
Next rngMyCell
End Sub
Then change the ActiveSheet with the correct sheet and the column hardcoded as 5 with the correct one. Run the code above in an empty Excel, to understand what it does. Then change it a bit, until it matches your needs.
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 working with three sheets. Worksheet Start Page has dates from A4 to lastrow. I have a Fund trend sheet with dates from A11 to last row. The vlookup is searching for Dates in the Fund trend sheet based on the list of Dates in the start page sheet. The search table range in the Fund trend sheet is Range(A11:C11) to lastrow. When the date is found it offsets (3,0), and that value is presented is sheet Acurred Expenses Range("C7"). This will loop till the lastrow in sheet start page A4.
=VLOOKUP('Start page'!A4,'Fund Trend'!A11:C21,3,0)
=VLOOKUP('Start page'!A5,'Fund Trend'!A12:C22,3,0)
as code i have not been successful:
Sub equity()
Dim Nav_date As Date
Dim equity As Integer
Nav_date = Sheets("Start page").Range("A4")
equity = Application.WorksheetFunction.VLookup(Nav_date,_
Worksheets("Fund Trend").Range("A11:C12"), 3, False)
Sheets("Acurred Expenses").Range("C7") = equity
End Sub
I think this answer can be broken down into three parts: correctly referencing the properties of a Range object, retrieving the last row of data, and using a loop
Correctly referencing the range's value:
The first thing that I noticed is that you are attempting to assign a Date variable as a Range object.
This line:
Nav_date = Sheets("Start page").Range("A4")
Should be:
Nav_date = Sheets("Start page").Range("A4").Value
A Range is an object with has properties and methods. You must explicitly reference what it is about the range you want to get. It's value, it's cell address, etc.
Likewise this incorrect syntax is repeated below. The line:
Sheets("Acurred Expenses").Range("C7") = equity
Should be:
Sheets("Acurred Expenses").Range("C7").Value = equity
EDIT: Per the comments whytheq raises the point of default properties. Technically the code Sheets("Acurred Expenses").Range("C7") = equity is not incorrect, and will work, because the default property of the range is Value. I tend to prefer to be more explicit, but that is my personal preference so I always use Range.Value so there is not ambiguity. Either way should work though!
Retrieving the last row of the worksheet
To find the last used row of the data in the worksheet, we can start at the bottom of the workbook and "look up" until we find the first row (which will correspond to the last row of the data in the worksheet).
This code would be the same as activating the last cell in column A and them pressing CTRL+Shit+↑
Sub LastRow()
Dim lRow As Long
lRow = Cells(Rows.Count, 1).End(xlUp).Row
Debug.Print lRow
End Sub
To reiterate, this starts at the very bottom row and goes all the way up, returning the row number of where it stops. This corresponds to the last value entered in column A. You might need to change A if your data is in a different column.
The loop
Finally, we can put everything we've learned together. After you have lRow which corresponds to your last row in your set of data we can perform a look for the VLOOKUP like so:
Sub equity()
Dim Nav_date As Date
Dim equity As Integer
Dim lRow As Long
Dim i As Long
lRow = Sheets("Start page").Cells(Rows.Count, 1).End(xlUp).Row
For i = 4 To lRow 'Begin in Row 4 of the "Start page" sheet
Nav_date = Sheets("Start page").Range("A" & i).Value
'Tell code to continue even if error occurs
On Error Resume Next
equity = Application.WorksheetFunction.VLookup(Nav_date, _
Worksheets("Fund Trend").Range("A11:C12"), 3, False)
'Check the results of the VLOOKUP, an error number of 0 means no error
If Err.Number = 0 Then
'Here I use i+3 because the data started in row 7 and I assume
'it will always be offset by 3 from the "Start Page"
Sheets("Acurred Expenses").Range("C" & i + 3).Value = equity
End If
'Return to normal error handling
On Error GoTo 0
Next i
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.