I am working on a userform to record counts at certain times of the day.
I automatically add the date and day to the first two fields. There are different fields for one day of the week compared to the others, hence the if statement:
Private Sub UserForm_Initialize()
If Format(Date, "ddd") <> "Sat" Then
DateWkd.Value = Format(Date, "mm/dd/yy")
DayWkd.Value = Format(Date, "ddd")
Else
DateSat.Value = Format(Date, "mm/dd")
DaySat.Value = Format(Date, "ddd")
End If
End Sub
Data will be submitted at different times of the day.
How do I find if the last row's day value equals today's day to update the row, or create a new row if the date doesn't match?
Will write out a little bit more as comments aren't great for code.
In general, you should appropriately qualify references, so in this case with using your userform, you will need to specify the sheet/etc.
Dim lr as Long, varDay as Long
varDay = 1 'assumes using ColumnA, but you could make this a Find() function if necessary
With Sheets("Data")
lr = .Cells( .Rows.Count, varDay).End(xlUp).Row
If DateTextBox.Value <> .Cells(lr,varDay).Value Then 'Not sure if you want just Date (todays' date, no time) or the value in your input for the comparison (gave arbitrary name for textbox example)
'Do your thing
End if
End With
This would be in your command button for entering data, to determine where it would go. If you need to pull data from the sheet on initialize, you would then set textbox.value = .cell references... note that these two situations are not within the same module.
Related
I'm trying to filter out all but todays date using a macro (for the first time)
I want to create a macro or two that will show only rows using the date in which it's viewed. I've tried using the below, but it hides all rows containing a date
Dim cell As Range
For Each cell In Range("A10:A1000")
If cell.Value <= Date Then
cell.EntireRow.Hidden = False
End If
Next
End Sub
Basically you don't need VBA to achieve this: you could use the filter functionality of Excel.
But if you want to do it via VBA this is a routine that does what you want:
Option Explicit
Public Sub hideRowsIfNotDate(rgToCheckDate As Range, dateToBeVisible As Date)
Dim c As Range
For Each c In rgToCheckDate.Cells
If IsDate(c.Value) Then 'just to be on the safe side if there is no date
If c.Value <> dateToBeVisible Then
'hide rows with different date
c.EntireRow.Hidden = True
Else
'show rows that match the date - just in case they were hidden before
c.EntireRow.Hidden = False
End If
End If
Next
End Sub
Advantage of this solution:
you can pass different dates or ranges, therefore you can reuse the sub for different scenarios
when you call the sub from your main code you simply know by reading the subs name what it is doing (w/o reading the code itself) - someone else (or you in 3 months) will appreciate that :-)
You will call the routine from your main code like this:
Public Sub test_hideRows()
Dim dateToBeVisible As Date
dateToBeVisible = Date '= today
Dim rgToCheck As Range
Set rgToCheck = ActiveSheet.Range("A10:A1000")
hideRowsIfNotDate rgToCheck, Date
End Sub
Have you tried AutoFilter? I assume that your data are stored in Rows("10:1000"), dates - in the column A and you have some headers in Rows(9). With that in mind:
Set Source = Rows("9:1000")
Field = Range("A:A").Column
Value = Format(Date, Range("A10").NumberFormatLocal)
Source.AutoFilter Field, Value
If you have a custom date format, put that instead of ...NumberFormatLocal
Apologies in advance as this is my first time posting something on this site and am not the best at explain issues.
I have a spread sheet, this has production data such as meters daily, meters monthly etc. These values are updated by adding TAGS from a PLC using Rockwell VantagePoint Excel add-in (if your unfamiliar with this it shouldn't matter this part is not what I am struggling with)
I need I way to copy data from one cell to another cell on the same sheet at month end. Basically the Meters monthly field needs to copied into another cell at the end of the month to record meters run for that month. The monthly meters run resets back to 0 at the end of the month.
Basically I need to copy the value in J7 into the corresponding month in W column at the end of that month. If it could ignore the year that would be advantageous as I don't need it to keep the old values and would mean I just need one column.
I have some experience at MS-Excel, also VBA but mainly in MS-Access never in MS-Excel. If answers could be explained as simply and hands on as possible it would be appreciated.
After Googling the issue I came across this formula and changed the ranges to fit my sheet but Excel doesn't like it saying it contains an error
=QUERY( A1:B6; "select B where A =date """&TEXT(TODAY();"yyyy-mm-dd")&""" "; 0
Sorry again if I haven't explained myself properly.
If your workbook isn't guaranteed to be open at the end of each month I would update the value every time it gets opened, like(Should be placed in ThisWorkbook):
'Runs when you open the workbook
Private Sub Workbook_Open()
'Loops through U3 to the last used cell in that column
For Each c In Range(Cells(3, 21), Cells(Rows.Count, 21).End(xlUp))
'Applies the J7 value to the current month and exits the sub
If Month(c) = Month(Now) Then c.Offset(, 2).Value = [J7]: Exit Sub
Next c
End Sub
Also, not that it matters but, I would apply the following formula in U3:U14 to always get the correct dates:
=EOMONTH(DATE(YEAR(TODAY()),ROW()-2,15),0)
Okay, I'm still not super sure what the question is and I know more Access VBA than Excel VBA, but here's something that might help to find a solution.
You can make a check date function that returns a Boolean value:
Public Function EoMonthCheck() As Boolean
Dim eo_month As Date, today As Date
eo_month = Format(WorksheetFunction.EoMonth(Now(), 0), "yyyy-MM-dd")
today = Format(Now(), "yyyy-MM-dd")
If today = eo_month Then
EoMonthCheck = True
Else
EoMonthCheck = False
End If
End Function
And the,, to add a value to the "W" column, we might use something like this:
Public Function AppendValue(Optional target_cell As String = "J7")
''' This could be a subroutine, too, I guess, since we're not returning anything.
Dim i As Integer
''' Activate whatever sheet you want to work with
Worksheets("Sheet1").Activate
If EoMonthCheck() = True Then
''' Look up the bottom of the 'W' column and find the first non-empty cell
''' Add 1 to that cell to get you to the next cell (the first empty one).
i = Cells(Rows.Count, "W").End(xlUp).Row + 1
''' Set the value of that empty cell in the 'W' column to the value of 'J7'
''' which will happen after we evaluate whether it is the end of the month.
Cells(i, "W").Value = Range(target_cell).Value
End If
Then, you could maybe trigger that each time the workbook opens.
I am trying to create a macro that will first allow the user to easily transfer data to another sheet based on a dropdown list to select the month. I want the user to able to enter the date in the field I have created, then use buttons on the sheet to first select which month to paste though, then confirm the paste. I have twelve named ranges from Ref_Jan to Ref_Dec on a sheet named "DB - Ref Monthly" I am working on putting together the pieces but I'm stuck here with my test program:
Sub Button8_Click()
Dim MonthSelector As Range
Dim Ref_May As Range
If Range("MonthSelector") = Range("Ref_May") Then
Sheets("DB - Ref Current").Range("Ref_Current").Copy
Sheets("DB - Ref Monthly").Range("Ref_May").PasteSpecial xlPasteAll
Application.CutCopyMode = False
Application.ScreenUpdating = True
Else
End If
End Sub
My current plan is to use 12 if statements to refer to each month, as I already have the copy/paste portion of the code working in another sheet. If I am going about this all wrong I would not mind some guidance. Please let me know if I have been unclear and can provide additional information.
Use looping to iterate months then no need to duplicate a code logic.
Dim arrMonth As New Collection
Dim idx As Integer
Dim val As String
Call arrMonth.Add("Jan")
Call arrMonth.Add("Feb")
Call arrMonth.Add("Mar")
'..etc..
Call arrMonth.Add("Dec")
For idx = 1 To arrMonth.Count
val = arrMonth.Item(idx)
Call MsgBox(idx & "=" & val)
Next
Assuming Range("MonthSelector") is a cell that has a value from a list of months (Jan, Feb, Mar, etc.), and you've got corresponding named ranges Ref_Jan, Ref_Feb, Ref_Mar, etc., you could just do this:
Sub Button8_Click()
Sheets("DB - Ref Current").Range("Ref_Current").Copy
Sheets("DB - Ref Monthly").Range("Ref_" & Range("MonthSelector").Value).PasteSpecial xlPasteAll
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
I have a list of sequential dates (1/01/2012, 2/01/2012, 3/01/2012 etc) in a column in Excel. I want Excel to check the current date and add that date to the bottom of the range if it isn't there already. I only want this to happen once per day so that there are no redundant entries.
For example:
If the list ends at 2/06/2013 and I open the workbook on 2/06/2013, nothing would happen. However, if I opened the workbook again the next day, on 3/06/2013, then that date would be added to the bottom of the list automatically.
I also have two formulas I need copied into the next two cells of that row. If a date was generated for A20, the formulas would be on B20 and C20. The cell references for year/month/date would need to increment by 1 (as in one row) for every new date entry.
For reference, the first formula is:
=SUMIF('Sheet1'!A:A,DATE(YEAR(A1),MONTH(A1),DAY(A1)),'Sheet1'!C:C)`
And the other formula is similar enough to be redundant for the point of solving this problem.
Thanks in advance.
Edit:
I worked out how to check the list and add a new date
Sub CheckDateAndEnter()
If Sheet10.Cells(Rows.Count, 1).End(xlUp).Value <> Date Then
Sheet10.Cells(Rows.Count, 1).End(xlUp)(2, 1) = Date
Sheet10.Cells(Rows.Count, 1).End(xlUp)(1, 2) = "=SUMIF('Sheet1'!A:A,DATE(YEAR(A304),MONTH(A304),DAY(A304)),'Sheet1'!C:C)"
End If
End Sub
however, those cell references in the formula need to increment once for a new column each time this occurs and I'm not sure how to implement that.
If you place this code into the "ThisWorkbook" Modules in the VBA Editor, and make sure you safe your file as a "macro-enabled workbook" it should work.
Hard-coding the formula here probably isn't the best method, and the way I've done it could be cleaner using the R1C1 notation.
Private Sub Workbook_Open()
Dim Sheet As Worksheet: Set Sheet = ThisWorkbook.Worksheets("Sheet1") ' Reference to your worksheet
Dim Entry As Range: Set Entry = Sheet.Cells(Sheet.Rows.Count, 1).End(xlUp) ' The Last Populated Cell in Column A
If IsEmpty(Entry) = True Then ' Optional, Used to populate the first cell
Entry.Value = Date
Entry.Offset(ColumnOffset:=1).Formula = "=SUMIF('Sheet1'!A:A,DATE(YEAR(A" & Entry.Row & "),MONTH(A" & Entry.Row & "),DAY(A" & Entry.Row & ")),'Sheet1'!C:C)` "
Exit Sub
End If
If Year(Entry) = Year(Date) Then
If Month(Entry) = Month(Date) Then
If Day(Entry) = Day(Date) Then
Exit Sub ' Last Entry = Today, Do Nothing!
End If
End If
End If
Set Entry = Entry.Offset(RowOffset:=1) ' Last Entry != Today, Goto Next Row and create Entry.
Entry.Value = Date
Entry.Offset(ColumnOffset:=1).Formula = "=SUMIF('Sheet1'!A:A,DATE(YEAR(A" & Entry.Row & "),MONTH(A" & Entry.Row & "),DAY(A" & Entry.Row & ")),'Sheet1'!C:C)` "
End Sub
I'm making this more challenging in my head than it has to be, but since I haven't been using vba or excel recently I'm using this as my excuse. Please don't question the methodology :) as this is only a small step I'm trying eliminate for someone to save some time, until I can redo the entire process. I would do the reverse, but this is an invoice of sorts that they are using....
I'm thinking macro or function is what is needed and not a formula since the data on worksheet 2 will change each month and there is no date I can reference.
What I'd like to do:
I have a cell on worksheet 2 that will change once a month. I want to place the value of the cell from Worksheet 2 into a cell in worksheet 1 each month that she changes it.
Each month would be represented in column A and the value of the cell from Worksheet 2 during that month needs to be place in column B.
Column A Column B
12/5/2012 $3,459,877.81
1/8/2013 $9,360,785.62
2/8/2013
3/8/2013
4/8/2013
So when she changes worksheet 1 for February the number will populate next to 2/8 and so on. I was thinking do it when she saves the document, or make it a shortcut she can hit or just scrap it and tell her it's not worth.
Giving a Cell a name to reference from you can do some neat stuff with the Target parameter passed to the Worksheet_Change function:
'Add this function to the sheet that has the cell being
'+changed by the user (Sheet 2)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim strCellName As String
strCellName = "ChangeMe"
'If the cell we changed was the ChangeMeCell
If Target.Address = Sheet2.Range(strCellName).Address Then
'Store value
Dim intLastRow, intValue As Integer
intValue = Range(strCellName).Value
'Find the cell in Sheet 1 Column A that matches this month
intLastRow = Sheet1.Range("A:A").End(xlDown).Row
For Each cl In Sheet1.Range("A1:A" & intLastRow).Cells
'Ensure cell value is date
If IsDate(cl.Value) Then
'If date is today's date
'Note that Math.Round(<date>, 0 ) essentially removes the time
'+from any date value so #01/02/03 04:05:06# becomes #01/02/03#
If Math.Round(cl.Value,0) = Math.Round(Now,0) Then
'Update column B's value
Sheet1.Range("B" & cl.Row).Value = intValue
End If
End If
Next
End If
End Sub
This assumes you have the sheet layout with the "invoice values" in Sheet1 and the cell being changed in Sheet2. You need to give that cell a name.
Using the cell Name box to the left of the Function bar call the cell that changes "ChangeMe" or anything you wish to change it to, update that cell name in the first line of the function and this function will do all the rest.
It is important to note that the dates must be correctly formatted for your systems region. to make sure it is showing the right month - format them into LongDate so you can see them as 08 March 2013 instead of 03/08/13 which may get confusing the longer it goes on. Speaking as a British programmer, dates are the bane of my life!
Edit: I have update the code to compare the dates by the full date minus the time, instead of the previous monthly comparison, if you still need to subtract or add a month to either date value, just use the DateAdd("m", <date>, <value>) to add or subtract the month.
Edit: DatePart Function page is a useful resource for those wanting to know more about DatePart()
For my example, I'm using cell G4 as the one that will be updated by your coworker. You have to have some way to persist the original value of G4 in order to tell when it's been changed. The easy way to do this is to pick some cell that is out of sight of the user and store the number there so you can reference it later. Here I've chosen cell AA1. The following code must be added specifically to Sheet2 since it needs to monitor the changed events on that sheet only so it can fire when G4 is updated.
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("G4") <> Range("AA1") Then
Dim lastRow As Long
Range("AA1") = Range("G4")
lastRow = Worksheets("Sheet1").UsedRange.Rows.Count
Worksheets("Sheet1").Cells(lastRow + 1, 1).Value = Date
Worksheets("Sheet1").Cells(lastRow + 1, 2).Value = Range("AA1")
End If
End Sub
Keep in mind that this is a very "quick and dirty" approach for this task, as there are no error handlers or much flexibility in the way it works.
EDIT --
One other method you could use is referenced here, and can simply check to see if a given cell has changed, without verifying the difference in value.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("G4"), Range(Target.Address)) Is Nothing Then
Dim lastRow As Long
Range("AA1") = Range("G4")
lastRow = Worksheets("Sheet1").UsedRange.Rows.Count
Worksheets("Sheet1").Cells(lastRow + 1, 1).Value = Date
Worksheets("Sheet1").Cells(lastRow + 1, 2).Value = Range("AA1")
End If
End Sub
Now, I'm able to capture the value from a formula in the cell and place it in a different cell in another worksheet. Here's my final product:
Private Sub Worksheet_Calculate()
Dim strCellName As String
strCellName = "ChangeMe"
If Sheets("Application of Moneys").Range(strCellName).Address <> PrevVal Then
Dim intLastRow, intValue As Long
intValue = Range(strCellName).Value
'Find the cell in Sheet 1 Column A that matches this month
intLastRow = Sheets("Certificate 1").Range("B:B").End(xlDown).Row
For Each cl In Sheets("Certificate 1").Range("B13:B25" & intLastRow).Cells
'Ensure cell value is date
If IsDate(cl.Value) Then
'If date is today's date
'Note that Math.Round(<date>, 0 ) essentially removes the time
'+from any date value so #01/02/03 04:05:06# becomes #01/02/03#
If DatePart("m", cl.Value) = DatePart("m", Now()) Then
'Update column B's value
Sheets("Certificate 1").Range("H" & cl.Row).Value = intValue
End If
End If
Next
End If
End Sub