With zero luck finding a solution on the web I was wondering if anyone here can help me. Below is an example of my calendar.
Above is my calendar with Month, weeknumber and days at the very top. At the very left there are names. I am trying to get the names of the persons who have F in cell of current day (if April the 13th was today). The days has DD.MM.YYYY Format.
Explained in details:
Im looking for a code that finds todays date in row 3. when that date is found find all cells in column W wich contains "F". Then i want the name of the person in that row.
And finally a bad illustrated image of what im thinking.
The output should look something like this. All the names should not be listed in one cell.
Hope for some help! -J
If your Row 3 has dates like DD/MM/YYYY but you changed the format to Custom and only included DD, then the following will work:
Sub foo()
Dim LastRow As Long
Dim LastCol As Long
Dim NextEmptyRow As Long
Dim SearchDate As String
LastRow = Sheet1.Cells(Sheet1.Rows.Count, "D").End(xlUp).Row
'SearchDate = Format(Now(), "dd/mm/yyyy")
'change the line below with the one above to search for today's date
SearchDate = "13/04/2017" 'find "today's" date
LastCol = Sheet1.Cells(3, Sheet1.Columns.Count).End(xlToLeft).Column 'get the last Column
Sheet2.Cells(1, 1).Value = "Output"
For i = 1 To LastCol 'loop through all columns
ValueToFind = Format(Sheet1.Cells(3, i).Value, "dd/mm/yyyy") 'format the values on row 3 to full date as dd/mm/yyy
If ValueToFind = SearchDate Then 'if date on Row 3 matches SearchDate then
For x = 4 To LastRow 'loop through rows
If Sheet1.Cells(x, i).Value = "F" Then 'if F exists on that column
NextEmptyRow = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row + 1 'check the next free row on Sheet 2 column A
Sheet2.Cells(NextEmptyRow, 1).Value = Sheet1.Cells(x, 4).Value 'copy the name to Sheet2 on the next available Row
End If
Next x
End If
Next i
End Sub
Related
I have an excel sheet that I need to delete rows based on the values from two different cells.
The initial excel sheet is created from a report that will populate the data from the previous month up until the current day. Depending on the day the report is ran I could have an extra three days or four days worth of data that I do not need. I would like to delete the rows that I do not need based on the month and time columns.
Simplified Excel Sheet
I would like to delete everything past the last day of the month except for the initial data on the 1st at 0:00. In this example I would like to delete everything below row #4.
Any help is greatly appreciated.
So far I have tried the following and I can filter the data on the date column, but I have not been successful at combining the filter for the second column.
Sub Delete_Row_Cell_Contains_Text()
Dim Row As Long
Dim i As Long
Row = 15
For i = Row To 1 Step -1
If Cells(i, 1) = "12" Then
Rows(i).Delete
End If
Next
End Sub
Try something like this:
Sub Delete_Row_Cell_Contains_Text()
Dim i As Long, ws As Worksheet, currMonth As Long, dt As Date
Dim keepDateTime
currMonth = Month(Date)
keepDateTime = DateSerial(Year(Date), currMonth, 1) 'date/time row to keep
Set ws = ActiveSheet
For i = ws.Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1 'from last date up...
dt = ws.Cells(i, 1).Value
If Month(dt) <> currMonth - 1 Then 'if not this month-1
'if not the first of this month at midnight
If dt + ws.Cells(i, 2).Value <> keepDateTime Then
ws.Rows(i).Delete
End If
End If
Next
End Sub
I have created a spreadsheet to format some raw data, and would like to insert the below in column F once the last row is found.
TOTALS
YTD Dividends
(row in between)
YTD Interest
(row in between)
YTD Gain/Loss
Used the below to get the TOTALS, but cannot figure out how to add the additional titles below in column F. Is this not possible because i am using last row? The amount of rows will vary for each spreadsheet so i need to find the end and insert the values.
'...
End With
Dim lastrow As Long
lastrow = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row + 2
With Selection
ActiveSheet.Cells(lastrow, "F").Value = "TOTALS"
End With
End Sub
You could do it like this:
'...
End With
'offset 2 rows down and 2 columns to the right
With ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Offset(2, 2)
.Value = "TOTALS"
.Offset(1).Value = "YTD Dividends"
.Offset(3).Value = "YTD Interest"
.Offset(5).Value = "YTD Gain/Loss"
End With
End Sub
I am looking to create a cash forecast using the average of the last 6 days that correspond to a particular weekday.
My dataset is formatted as such:
Row 1: Headers
Column A: Date
Column F: Cash position
Column G: Day of week
After column G is filtered to a specific day (i.e. Monday), I'd like to extract the last 6 visible values in columns A & F. Using column A as an example, here is my current failed code:
Range("A1").Select
Selection.End(xlDown).Select
Range("A460:A485").Select
Range("A485").Activate
The range on line 3 was coded from shift-clicking upwards 5x from the bottom of the data set. I'm looking to copy the data within this range, while not defining what the range is.
Thanks for any help provided.
Scan up the sheet for 6 dates that are mondays and fill an array. Then dump the array to the other sheet.
Option Explicit
Sub Last6Mon()
Dim ar(1 To 6, 1 To 2) As Variant
Dim lastrow As Long, i As Long, r As Long
i = 6
With Sheets("Sheet1")
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For r = lastrow To 2 Step -1
If WorksheetFunction.Weekday(.Cells(r, "A")) = vbMonday Then
ar(i, 1) = .Cells(r, "A") ' date
ar(i, 2) = .Cells(r, "F") ' cash posn
i = i - 1
If i = 0 Then Exit For
End If
Next
'another worksheet
Sheets("Sheet2").Range("A2:B7") = ar
End With
End Sub
My code below has two parts. The first part basically sets a cell as a date that is 6 months from now. This part works but I'm having trouble with the second part.
The second part is after filtering a table, I want to compare each cell in column H (which is a date value) with that future date in the first part. If the date in column H is after the future date, cell AI of that row will be set as "Yes"
Set Database = ThisWorkbook.Worksheets("Sheet1")
Dim i As Long, LastRow As Long
LastRow = Database.Cells(Rows.count, "A").End(xlUp).Row
With Database.Range("AI1")
'Adds 6 months to today's date in cell AI1 in sheet
.Formula = "=EDATE(Today(),6)"
'Converts that date to 1st day of the month (e.g. 17/01/2020 is converted to 01/01/2020
.Value = DateSerial(Year(Range("AI1")), Month(Range("AI1")), 1)
End With
For i = 2 To LastRow
'This line throws a run-time error 13: type mismatch
If Cells(i, "H").SpecialCells(xlCellTypeVisible) > Database.Range("AI1") Then
Cells(i, "AI").Value = "Yes"
End If
Next i
Below should work, with the note that it could replace the value in AI1 on the first loop iteration. Not sure you really want that?
Dim c As Range, vis As Range, dt as Date
'calculate cutoff date
dt = Application.EDate(Date, 6)
dt = DateSerial(Year(dt), Month(dt), 1)
On Error Resume Next 'ignore error if no visible cells
Set vis = database.Range("H1:H" & LastRow).SpecialCells(xlCellTypeVisible)
On Error GoTo 0 'stop ignoring errors
If Not vis Is Nothing Then 'any visible cells ?
For Each c In vis.Cells
If c.Value > dt Then c.EntireRow.Range("AI1").Value = "Yes"
Next c
End If
I am looking to create an excel workbook, where I will have a button(s) - when clicked on it, it should write the date, number of times it clicked on that day.
I am able to write the date, based on a macro, however I am struggling in two scenarios. Presently I am only able to update the date in the same cell.
1. I would like to append it, in the row below, rather erase the same cell and update it.
2. The number of times the user clicked on the day (should be on the column next to it), should be updated dynamically, and should match the date column next to it.
Any thoughts on the logic, would be helpful.
This is the result, I am looking to get, this is two columns.
7/29/19 5
7/30/19 9
7/31/19 12
So to start, we're going to have to have our program figure out what cell contains the most recent date that is in our list. Once we get that cell, we can compare it's value to the current date in order to determine if we need to add +1 to that day or start a new row.
I have provided an example subroutine below and you will have to replace the contents inside of the square brackets to match your sheet that you're working in.
Sub buttonPressed()
Dim lastRow, dateColumn As Long
Dim lastDate As Date
Dim clickCtr As Long
With Sheets([sheetName])
'Set the column containing dates.
dateColumn = [column number where dates are stored]
'Get the last row containing a date and save it into lastRow
lastRow = .Cells(.Rows.Count, dateColumn).End(xlUp).row
'Convert value of lastRow into a date
lastDate = DateValue(.Cells(lastRow, dateColumn).Value)
'Compare last date to current date
If (lastDate = Date) Then
'Get the current button press count and add 1 to it
clickCtr = .Cells(lastRow, dateColumn + 1).Value + 1
'Replace contents of cell with new click amount
.Cells(lastRow, dateColumn + 1).Value = clickCtr
Else
'Add the new date to the next row
.Cells(lastRow + 1, dateColumn).Value = Date
'Start the counter next to the new date
.Cells(lastRow + 1, dateColumn + 1).Value = 1
End If
End With
End Sub
If I understand what you are asking here's my attempt at it.
Sub stuff()
Dim dateCol As Range
Dim countCol As Range
Set dateCol = ThisWorkbook.Worksheets("Sheet2").Range("A:A") ' Change to proper sheet
Set countCol = ThisWorkbook.Worksheets("Sheet2").Range("B:B") ' Change to proper sheet
Dim foundDate As Range
Dim searchDate As String
searchDate = Format(Now(), "m/dd/yyyy")
Set foundDate = dateCol.Find(what:=searchDate, lookat:=xlWhole)
If Not foundDate Is Nothing Then
foundDate.Offset(0, 1).Value = foundDate.Offset(0, 1).Value + 1
Else
Dim newEntry As Range
If dateCol.Cells(1, 1).Value <> "" Then
Set newEntry = dateCol.Cells(dateCol.Cells.Count, 1).End(xlUp).Offset(1, 0)
Else
Set newEntry = dateCol.Cells(1, 1)
End If
newEntry.Value = searchDate
newEntry.Offset(0, 1).Value = 1
End If
End Sub