I'm trying to build a macro that will auto sort some values in an excel table across a couple of multiple sheets.
Im looking to make it look at row r and s and compare them for the highest "date" value and then if the greatest value is less than 3 months old copy to sheet 4 and if ts greater than 3 months old copy to sheet 7.
I have the copy part working just not the if function for greatest date:
Dim greatestDate As Date
If Sheets(source).Cells(lRow, "R").Value > Sheets(source).Cells(lRow, "S").Value Then
greatestDate = Sheets(source).Cells(lRow, "R").Value
Else
greatestDate = Sheets(source).Cells(lRow, "S").Value
End If
i think the issue is the type of variable but im not sure any help would be appreciated.
While you aren't telling us the error you're getting, you should use the DateValue function to eliminate any Time properties and just evaluate Date.
If DateValue(Sheets(source).Cells(lRow, "R").Value) > DateValue(Sheets(source).Cells(lRow, "S").Value) Then
Related
I recently wrote a fairly simple bit of VBA code so that I can keep long-term track of what I am wearing each day. For this I made a Macro connected to a Command Button, and it looks like the following:
Private Sub WearingToday_Click()
Dim NextCol As Long
NextCol = Cells(1, Columns.Count).End(xlToLeft).Column + 1
Cells(1, NextCol).Value = Date
Cells(ActiveCell.Row, NextCol).Value = "1"
End Sub
The code simply adds today's date on the next available column, under which it adds the number "1" on the row which I've chosen.
My problem is, though, that if I activate the macro more than once a day, the date serial number of the second activation will have an additional 1 in the end, giving me a date corresponding to the year 3000-something. To make it clearer: I have worn two things on November 20th, which gives two adjacent columns with the same date; but only the first column of these dates shows the correct serial number.
I might mention that I'm importing the data into Qlik Sense, where I later will do some visualisations. I see the date serial numbers upon storing the data as a QVD-file and looking at it from QViewer.
The interesting thing is that the string representation of both serial numbers -- in the Excel spreadsheet -- is correct. As such, I am not sure if the problem indeed only exists as a consequence of the transition from .xlsm to .qvd, or if it is there from the beginning.
I hope I have been clear with my issue and that someone will be able to help me fix this, or at least make me understand what possibilites I have going forward.
Thanks in advance.
The following code will check to see if the last column heading is already today's date and, if so, just update the same column:
Private Sub WearingToday_Click()
Dim LastCol As Long
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
If Cells(1, LastCol).Value2 < Date Then
LastCol = LastCol + 1
Cells(1, LastCol).Value = Date
End If
Cells(ActiveCell.Row, LastCol).Value = 1
End Sub
I suspect that your export to Qlik Sense is being confused by having two columns with the same header (i.e. the date), and it might just be appending a "1" to the second header to make each header unique. But I have never heard of, or seen, Qlik Sense so I can't be sure. If that is the cause of the weird behaviour in Qlik Sense, then ensuring you don't have duplicate headers should make your problems disappear.
Hi i need help on creating a VBA to copy range of cells repeatedly with one column having increments.
Current data
Expected Output
I found a vba but will only copy the rows based on column C without increments on the date
Excel VBA automation - copy row "x" number of times based on cell value
I'm not sure why you would need to do this as excel has built-pattern pattern recognition for these scenarios, after entering two succesive dates if you hover over and click the border of the cell then drag down, the desired date range will appear in the column automatically.
If you still insist on doing this programatically for whatever reason then your question already has multiply feasible solutions here: Add one day to date in cells using VBA
Specify each cell in turn then increment the value by the corresponding row number to return desired date range in column A:
Range("A2").Value = Range("A2").Value + 2 ' add 2 days
Range("A3").Value = Range("A3").Value + 3 ' add 3 days
Range("A4").Value = Range("A4").Value + 4 ' add 4 days
'-------- So on and so forth until desired range is acheived --------'
or alternatively:
Range("A2").value = DateAdd("d", 2, CDate(Range("A2")))
Range("A3").value = DateAdd("d", 3, CDate(Range("A3")))
Speaking as someone who had to learn the hard way, please take my advice and ensure you research your problem thouroughly to find a solution before posting. Refer to the guidelines here if needed.
I have a ton of excel sheets that each have 3 excel workbook tabs. On the last one there will be a ton of data but one column will be a date column with a bunch of different dates underneath. The date format will be MM/DD/YYYY. I need to advance each date ahead by 4 years.
I imagine that I will need to select the correct workbook, search for the particular column, and then loop to iterate through each value underneath that column to advance it, but the day itself needs to stay the same. For example, if its 10/05/2017, it needs to be 10/05/2021. Any suggestions or help would be great. Thank you in advance.
Thank you for the help, I realize I wasn't very helpful at all with my question. I'm very new to VB script and excel macros in general. I hadn't gotten how to search for the column itself as I would like it find the column no matter what the column value is (possibly search for a cell that says "Date" through the entire sheet?, I was just trying to add the 4 years to start with and couldn't find the function I needed. This is what I had from what I derived and seems like this is very wrong ha.
Do Until IsEmpty(ActiveCell)
Set ThisCell = ActiveCell
ThisCell = DateAdd("yyyy", 4, ColumnValueHere)
' Step down 1 row from present location.
ActiveCell.Offset(1, 0).Select
Loop
You'll be wanting the DateAdd function
Try something like this:
Sub AddDates()
Dim lastRow as integer
Dim theSheetImWorkingOn as worksheet
Dim theColumnNumberForTheDates as integer
theColumnNumberForTheDates = 5 ' change this to be the column number you want
Set theSheetImWorkingOn = Sheets("Put your sheet name here")
lastRow = theSheetImWorkingOn.Cells(1000000, theColumnNumberForTheDates ).End(xlUp).row
For x = 2 to lastRow ' assuming your data starts on row 2
theSheetImWorkingOn.Cells(x, theColumnNumberForTheDates) = DateAdd("yyyy", 4, theSheetImWorkingOn.Cells(x, theColumnNumberForTheDates))
Next x
End Sub
I'm new to this site as well as to VBA. I've been working on a project and have run into a wall. I hope someone can help me out. What I'm trying to do is create a loop that will go through the specified sheet and pull data that matches my criteria, copy and paste it to another sheet, where I will be calculating it and then showing the results of the calculations in another sheet.
so, I have the following code (excel VBA) that is suppose to go through the sheet and pull all records that match the current week (I'm also trying to add the current year, no luck so far) and paste all matching records to the sheet named Archieve:
Sub DataByWeek()
Dim cw As Integer ' current week
Dim cy As Integer ' current year
Dim lr As Long 'last row of data
Dim i As Long ' row counter
'Get week number of today's date
cw = Format(Date, "ww")
cy = Format(Date, "yyyy")
ActiveWorkbook.Worksheets("Daily DB").Activate
' Find last row of data plus one down
lr = Sheet7.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
For i = 2 To lr
If Cells(i, 6) = cw Then
Range(Cells(i, 1), Cells(i, 5)).Copy
ActiveWorkbook.Worksheets("Archieve").Activate
Range("A2").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
End If
Next i
End Sub
This code does everything I want it to do except return beyond the first matching iteration. The code does go through all data on the sheet named Daily DB, but only returns the first matching record. I've tried looking online (many site including this one) to see if I missed something or did something wrong, but I can't find where I went wrong.
I would also like to know how I can add a second criteria to the If statement condition. I'd like to add the year so that the condition reads something like
If Cells(i, 6 & 7) = cw & cy Then
...
Where i, 6 contains the week number and i, 7 contains the year. In other words, I'd like to 'say' find all records that contain the x week of x year.
Sorry if this was too long and thank you in advanced for any and all help.
If you add ActiveWorkbook.Worksheets("Daily DB").Activate before the End If statement, I believe it would fix your problem. I'm not sure it's the most efficient way though.
I have an excel sheet with lots of data. As you may know, this comes with lots of problems. One major one is having too much data. I am not familiar with vba, but I wanted to know how to clean data.
I have a sheet with 3 fields: date, time, and temp. The temperature is recorded on a minute by minute basis. The temperature is only recorded from 7 am to 10 pm, but the sheet is on a 24 hour basis. So my sheet has a lot of blank cells. So, I want to write a code that states:
if ((time < 7am) or (time > 10pm)):
delete row
Can I do this?
Also, another problem is that the data is not collected on weekends. I am not given a day field, only a date field in this format: 20130102 which is January 02 2013. I want to:
if ((date = saturday) or (date = sunday)):
delete row
Are either of these doable?
My sheets looks like the following:
A .............. B ......... .... C
date........ time ......... temp
Since both your dates and times are formatted differently than normal, we need to manipulate the values to get something to test against. Consider the following example (I've commented each line to help you follow along):
Sub DeleteRows()
Dim lastRow As Long
Dim Cell As Long
Dim dt As Date
'Work with the active sheet.
With ActiveSheet
'Find the last row of your dataset.
lastRow = .Range("A:A").Find("*", searchdirection:=xlPrevious).Row
'Format your time column to a readable time.
.Columns("B").NumberFormat = "[$-F400]h:mm:ss AM/PM"
'Loop through the rows, beginning at the bottom.
For Cell = lastRow To 2 Step -1
'Piece together the date.
dt = Mid(.Cells(Cell, 1), 7, 2) & "/" & _
Mid(.Cells(Cell, 1), 5, 2) & "/" & Left(.Cells(Cell, 1), 4)
'If the date is a Sat or Sun, delete the row.
If Weekday(dt) = 1 Or Weekday(dt) = 7 Then
.Rows(Cell).EntireRow.Delete
'If the time is before 7am or after 10pm, delete the row.
ElseIf Hour(.Cells(Cell, 1)) < 7 Or Hour(.Cells(Cell, 1)) > 22 Then
.Rows(Cell).EntireRow.Delete
End If
Next Cell
End With
MsgBox "Done!"
End Sub
A few things to note about the code. First, we must start at the bottom of the list because as we delete rows, the remaining rows shift upwards. If we were to go from top to bottom (e.g. A1 to A10), if we deleted row 5, row 6 would slide into its place, and the loop would skip row 5 (previously row 6) and go on to row 6. In other words, looping from top to bottom when deleting rows will ultimately skip rows unintentionally.
Second, I had to guess on your time format. While I believe I guessed correctly, I may not have. If I was wrong and my code doesn't change the time column into a readable time, record a macro while changing the format of that column and substitute the new format with mine ("[$-F400]h:mm:ss AM/PM"
).
And lastly, since your date column is an abnormal format (for Excel), we need to reorder the date so that Excel can read it. Once we've done that, we can use the resulting date to see if the date was a Sat. or Sun.
You can do it this way, assuming the column that contains your date is the 2nd (B) :
Dim i As Integer
for i = 1 to cellsCount
If Hour(Cells(i, 2)) < 7 Or Hour(Cells(i, 2) > 22 Then
Rows(i).Delete
Else If WeekDay(Cells(i, 2)) = 7 Or WeekDay(Cells(i, 2)) = 1 Then
Rows(i).Delete
End If
next
You can have more information about the WeekDay function here :
http://msdn.microsoft.com/en-us/library/82yfs2zh%28v=vs.90%29.aspx