I'm just trying to check the latest Date cell, which is in Column A, against the current date. If the difference is 30 days, I write a new row.
When I execute, it says I can't call CheckAttendance on Sheet("Occurences"). But why?
Option Explicit
Public LastCell As Long
Public today As Date
Function CheckAttendance()
Dim DaysSinceOcc As Integer
'returns last occupied row
LastCell = Cells(Rows.Count, 1).End(xlUp).Row
'gets current date
today = Date
'subtracts last cell in specified column from today's date.
DaysSinceOcc = today - Cells(LastCell, 1).Value
'writes what I want written in the cells I want it written in.
If DaysSinceOcc > 29 Then
Cells(LastCell, 1).Offset(1, 1) = "winback"
Cells(LastCell, 1).Offset(1, 2) = -0.5
Cells(LastCell, 1).Offset(1, 4) = "Earned back 0.5 pts for 30 days perfect attendance (AutoGenerated)"
Cells(LastCell, 1).Offset(1, 5) = "AUTO"
Cells(LastCell, 1).Offset(1, 0) = today
Else
End If
End Function
Sub Attendance()
Sheets("Occurences").CheckAttendance
'yes Occurences is suppose to be spelled like that (don't ask)
End Sub
edit: there are probably multiple problems with this. I fixed a lot of things, but then got stuck.
It seems that you want to parametrize your CheckAttendance routine so that it can be called on different worksheets. To do that, make it a Sub that takes a worksheet as parameter. Moreover
qualify you cells and ranges in the code
dim your variables and use Option Explicit
Option Explicit
Sub CheckAttendance(ws As Worksheet)
Dim DaysSinceOcc As Long, lastRow As Long, today As Long
lastRow = ws.Cells(ws.Rows.count, 1).End(xlUp).row
'gets current date
today = Date
'subtracts last cell in specified column from today's date.
DaysSinceOcc = today - ws.Cells(lastRow, 1).Value2
'writes what I want written in the cells I want it written in.
If DaysSinceOcc > 29 Then
ws.Cells(lastRow + 1, 1) = today
ws.Cells(lastRow + 1, 2) = "winback"
ws.Cells(lastRow + 1, 3) = -0.5
ws.Cells(lastRow + 1, 5) = "Earned back 0.5 pts for 30 days perfect attendance (AutoGenerated)"
ws.Cells(lastRow + 1, 6) = "AUTO"
End If
End Sub
Sub Attendance()
CheckAttendance Sheets("Occurences") ' <-- this is how you call it on any worksheet
End Sub
Related
I am trying to compare Dates in a vba script. I believe the main issue is my formatting however I am not sure how to solve it.
Sub Rem9()
Dim i As Long
Dim lr As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
wsName = ws.Name
lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
FirstDateRead = CDate("1, 1,2018") 'Initialize the first Day of the year as the last day
For i = 1 To lr
Debug.Print FirstDateRead
Debug.Print ws.Cells(i, 1).Value
If FirstDateRead > ws.Cells(i, 1).Value Then
ws.Cells(i, 3).Value = 121325
End If
Next i
End Sub
According to my output the First Date Read is never greater than the values I am pulling, Which it is for all cases. I have included here an example of the debug.print from the script I am running to show the date formats. Additionally I want to confirm the values I am drawing from are indeed datevaluse as when I run them through the IsDate() Function it returns True.
One other issue if that my date format for the value I call is swapping the year and day. Does anyone know how to solve that. When I use the format function it returns the date as.
Assuming the cells containing the dates are in text format, try wrapping the comparison value in a cDate:
If FirstDateRead > Cdate(ws.Cells(i, 1).Value) Then
ws.Cells(i, 3).Value = 121325
End If
Try using the DateDiff function instead:
Sub dateDifference()
Dim d1 As Date, d2 As Date
d1 = CDate("1, 2,2018")
d2 = Range("A1").Value ' insert a date in A1 to test
Debug.Print DateDiff("d", d1, d2) ' first parameter set to days
End Sub
Edit #1
Use Format to compare apples with apples, so to speak:
d2 = Format(Range("A1").Value, "dd/mm/yyyy")
I have the following problem: I try to filter a date column (A) in a worksheet (HISTORICALS) to return the highest and second highest date value. Currently, there is dates ranging from the 25th to the 31st of December in this column. Unfortunately, below formula (using the Large function) returns the 31st two times (and not the 30th and 31st as intended).
Sub Select_Last_Two_Days()
With Worksheets("HISTORICALS")
Highest_Max = Format(WorksheetFunction.Large(Worksheets("HISTORICALS").Range("A:A"), 1), "Short Date")
Second_Highest_Max = Format(WorksheetFunction.Large(Worksheets("HISTORICALS").Range("A:A"), 2), "Short Date")
Debug.Print Highest_Max, Second_Highest_Max
End With
End Sub
The column has approx. 2000 rows, with dates occuring multiple times. So ideally I would want to filter for distinct values and then return the two highest dates. Any idea how I can do that?
Simply translate Barry Houdinis answer from How to find the first and second maximum number? to VBA:
Sub Select_Last_Two_Days()
With Worksheets("HISTORICALS")
Highest_Max = Format(WorksheetFunction.Max(.Range("A:A")), "Short Date")
Second_Highest_Max = Format(WorksheetFunction.Large(.Range("A:A"), WorksheetFunction.CountIf(.Range("A:A"), WorksheetFunction.Max(.Range("A:A"))) + 1), "Short Date")
Debug.Print Highest_Max, Second_Highest_Max
End With
End Sub
The recommendations given in the comments are probably the simplest and least amount of code way to do things but here is another sugggestion:
Sub test()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Worksheets("HISTORICALS")
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim loopArr()
loopArr = ws.Range("A1:A" & lastRow).Value
Dim maxVal As Date
maxVal = Application.WorksheetFunction.Large(ws.Range("A1:A" & lastRow), 1)
Dim i As Long
Dim secondVal As Date
For i = UBound(loopArr, 1) To LBound(loopArr, 1) Step -1
If loopArr(i, 1) < maxVal Then
secondVal = loopArr(i, 1)
Exit For
End If
Next i
End Sub
Referring from my previous question.
VBA code to add current date in next cell
How do I select the previous ten days data from current date entry. Example :As per my first screenshot Lets say i get the today entry will be on Column E and I want to select previous 10 entries to create a graph. So, if I come tomo, my entry will be on F and I want to select column F,E,D,C,,,,
Keeping you previous code from link, try this (untested):
edited after OPs clarifications
Option Explicit
Sub Update()
Dim nCols As Long, nOffset As Long
With Range("A1").CurrentRegion
With .Offset(, .Columns.Count - 1).Resize(1, 1)
If .value < Date Then nOffset = 1
With .Offset(, nOffset)
.Resize(2, 1).value = Application.Transpose(Array(Date, Application.WorksheetFunction.Subtotal(103, Worksheets("Stock").UsedRange.Columns(1).SpecialCells(XlCellType.xlCellTypeVisible))))
nCols = IIf(.Column > 10, 10, 10 - .Column - 1)
.Offset(, -nCols + 1).Resize(, nCols).Select
End With
End With
End With
End Sub
I have the following code, that isn't quite doing what I want it to
Sub returnDates()
Dim StartD As Date, EndD As Date
StartD = Cells(5, 3)
EndD = Cells(6, 3)
For Row = 1 To (EndD - StartD)
Sheet3.Cells(Row, 3) = StartD + Row - 1
Next Row
End Sub
At the moment it looks for the start and end date on another worksheet. it then returns the dates in-between. At the moment though it doesn't display the start and end date just the ones in-between. I am also having problems specifying the exact cell I want the dates to appear. I am wanting first date to appear in B2
Try this:
Sub returnDates()
Dim StartD As Date, EndD As Date
StartD = Cells(5, 3)
EndD = Cells(6, 3)
For Row = 0 To (EndD - StartD) + 1
Sheet3.Cells(Row + 2, 2) = StartD + Row
Next Row
End Sub
Here I have declared the worksheets to work with and added some comments.
Sub returnDates()
Dim StartD As Date, EndD As Date
Dim lRow As Long
'Create the worksheet objects
Dim ws As Excel.Worksheet
Set ws = Application.ActiveSheet
Dim wsTarget As Excel.Worksheet
Set wsTarget = ActiveWorkbook.Sheets("Sheet3")
'Get the start and end.
StartD = ws.Range("C5")
EndD = ws.Range("C6")
'Loop through and put the dates on the target sheet
For lRow = 1 To (EndD - StartD)
wsTarget.Range("C" & lRow) = StartD + lRow - 1
Next lRow
'Put the end date on the target sheet.
wsTarget.Range("C" & lRow) = EndD
End Sub
Your code at the moment does show the start date but not the end date. I added + 1 to your For loop so that it will get that end date. I have changed you code to put the dates starting from B2 as you specify above.
Sub returnDates()
Dim StartD As Date, EndD As Date
StartD = Cells(5, 3)
EndD = Cells(6, 3)
For Row = 1 To (EndD - StartD) + 1
Sheet3.Cells(Row + 1, 2) = StartD + Row - 1
Next Row
End Sub
Please note that technically it is bad practice to use a variable without dimension / declaring it. You are using Row which is probably a reserved name which is why it doesn't complain. Also note that sheet3 is assumed as the active sheet if you want to use another sheet let me know and I will modify to accommodate it.
I am trying to keep the last 365 days visible in a micro tracking worksheet. As a new date gets inputted it would hide the first visible entry on the sheet so that only 365 cells are constantly displayed with the newest date at the bottom(ex Jan 15, 2015) and the oldest date at the top(Jan 15, 2014). When the user inputs Jan 16, 2015 it would hide Jan 15, 2014 so that the first entry is now Jan 16, 2014, and so on.
It has probably been about 15 years since I last used VBA but currently the code shown below will hide row 3 (where the first date and data is entered) but after that I can't get it to then hide row 4 once row 369 has text entered. Some insight into what I might be doing wrong would be greatly appreciated.
I would also assume that as this sheet became progressively larger it would start to slow down in opening or running smoothly so I would have to start fresh unless there is a way to make sure it always stays fast.
Dim i As Integer
Dim j As Integer
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
i = 3
j = 368
If Cells(j, j) = "" Then
Rows(i).Hidden = True
End If
i = i + 1
j = j + 1
End Sub
This is a completely different approach, but might suit you better in the long run.
Instead of hiding the rows to view what you are interested in. This approach uses two sheets.
Log Sheet: Contains all days
Report Sheet: Re-fills with only the last 365 days.
Setup Involved:
Set a second sheet up for your report, and give it the same headers as your Log Sheet.
Place the code provided in a module
If you want, you can add a workbook event so when the workbook opens, you can call this sub and have it update itself, or attach it to a hotkey or button.
This gives you plenty of room to create new formulas and charts to work over the set range of the report sheet. You can hide the Log Sheet.
Code:
Sub lastYearReportFill()
Dim lastRow As Long, lastCol As Long, lRow As Long, rRow As Long
Dim log As String, report As String
Dim today As Date, tempDate As Date
Dim daysTest As Long
log = "Log" 'Name your worksheets here
report = "Report"
today = Now
lastRow = Sheets(log).Range("A" & rows.count).End(xlUp).row
lastCol = Sheets(log).Cells(2, Columns.count).End(xlToLeft).column 'Using Header Row
For lRow = 3 To lastRow
tempDate = Sheets(log).Cells(lRow, 1)
daysTest = DateDiff("d", tempDate , today)
If daysTest = 365 Then
Exit For
End If
Next lRow
For rRow = 3 To 368
For lCol = 1 To lastCol
Sheets(report).Cells(rRow, lCol).Value = Sheets(log).Cells(lRow, lCol).Value
Next lCol
lRow = lRow + 1
Next rRow
End Sub
This should do the trick:
Sub HideRows()
Dim lngLastRow As Long
lngLastRow = Sheets("Sheet1").Cells(1, 1).End(xlDown).Row
If lngLastRow < 365 Then End
Rows(lngLastRow - 365).Hidden = True
End Sub
This is assuming that:
you are working in a sheet named "Sheet1" (if not, change the name in line 3 of the code accordingly)
the dates are in column A and start in row 1 (even the hidden ones). If the dates are in a different column, then change the second number in the cells(1, 1) statement to the number of the row. And if the dates do not start in row 1, change the first number of the cells(1, 1) statement to the row number of the first date.
And if you want to keep the row for the day exactly one year ago (as in, keep 1-15-14 on 1-15-15), you may need to change 365 in line 5 of the code to 366. This code also assumes that all other rows besides the one that was visible yesterday but doesn't need to be today are already hidden.
If you are concerned with speed, use Range AutoFilter Method which I answered HERE.
Applying it to your case:
Private Sub UpdateVisibleDates(sh As Worksheet, drng As Range)
With sh
Dim latest As Date
latest = .Range("A:A").Find("*", .Range("A1"), , , , xlPrevious).Value2
.AutoFilterMode = False
drng.AutoFilter 1, ">" & (latest - 365), xlAnd, "<=" & latest, False
End With
End Sub
Then just call it in your Worksheet_Change Event.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo halt
Application.EnableEvents = False
If Not Intersect(Target, Me.Range("A:A")) Is Nothing Then
Dim r As Range
Set r = Me.Range("A1:A" & Me.Range("A:A") _
.Find("*", Me.Range("A1"), , , , xlPrevious).Row)
UpdateVisibleDates Me, r
End If
forward:
Application.EnableEvents = True
Exit Sub
halt:
MsgBox "Error: " & Err.Number & vbCrLf & _
Err.Description, vbExclamation
Resume forward
End Sub
This is considering you have a complete date in Column A and your input doesn't skip dates.
But regardless, it will still hide dates not within the 365 date difference of the last entered date. HTH.