I have a csv file on excel that is ~CU for the column.
And the row gets keep updated (as of now it's 2606).
I'm trying to
delete all row that are before today's date as recorded on column D
no typing/text box/human input for today's date.
Sub deleterows()
lastrow = Cells(Rows.Count, 4).End(xlUp).Row
For i = lastrow To 2 Step -1
If Cells(i, 4).Value < *numeric value* Then Rows(i).EntireRow.Delete
Next i
End Sub
For dates (and currency), its always recommended to use Value2 instead of Value.
MSDN:
The only difference between this property and the Value property is
that the Value2 property doesn’t use the Currency and Date data types.
You can return values formatted with these data types as
floating-point numbers by using the Double data type.
So all you need to do is change this part If Cells(i, 4).Value < *numeric value* Then
With this If Cells(i, 4).Value2 < Date Then
and it evaluate as true if Column D is older than today.
Related
In my workbook "isum", I have the week number figured out by a WEEKNUM formula (right now is week 27) listed on column X under the label Week#. The worksheet is called "Orders" with data to see what orders are late. I am struggling to create an if/then statement that makes it so that all of the week numbers on column X (starting at X2) that are < 27 (the current week number out of 52) are labeled as "Late". I am not sure how to change this value to the text, but the hard part is making sure that each week changes until it gets to 52. Otherwise nothing will change that is "Late". If this does not make sense let me know, but this is what I have so far:
isum.Sheets("Orders").Activate
Range("X2").Formula = "=WEEKNUM(RC[-9])"
Range("X2", "X" & Cells(Rows.Count, 1).End(xlUp).Row).FillDown
'Change statement to say "Late" and account for changing week numbers after every week
If cell.Value < 27 Then cell.Value = "Late"
Try looping through the range
Dim col As Range: Set col = Worksheets("Orders").Range("X2:X" & <current week num>)
Dim i As Integer
For i = 1 To col.Rows.Count
col.Cells(RowIndex:=i, ColumnIndex:="X").Value = "Late"
Next
(http://codevba.com/excel/for_each_cell_in_range.htm)
I would suggest a custom number format that displays Late for weeknums less than 27 but retains the underlying numerical weeknum value for use in future calculations. This can be applied through a conditional formatting rule that checks the weeknum formula's result against the current weeknum for dynamic results week to week.
With isum.workSheets("Orders")
With .Range(.Cells(2, "X"), .Cells(.Rows.Count, "O").End(xlUp).Offset(0, 9))
.Formula = "=weeknum(o2)"
.NumberFormat = "0_)"
.FormatConditions.Delete
With .FormatConditions.Add(Type:=xlExpression, Formula1:="=x2<weeknum(today())")
.NumberFormat = "L\at\e_)"
'optionally apply a red fill color
'.interior.color = vbred
End With
End With
End With
I am trying to convert the used range of a column to hourly data using floor.
As a function in Excel I have =FLOOR(A2, "1:00")
So 2016-07-01 07:59:59.0000000 would become 01-07/2016 7:00
I would like to do this in VBA for just Column A where the first row is a header. I guess I'd need to convert to dateTime afterwards to but haven't thought about that yet (shouldn't be difficult).
I have tried this:
.Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)) = _
Application.WorksheetFunction.Floor(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp), "1:00")
But get wrong number of arguments error.
This:
.Range("A:A") = Application.WorksheetFunction.Floor("A:A", "1:00")
gives a type mismatch.
Not sure how to proceed.
The WorksheetFunction.Floor Method in VBA is a little different from the worksheets =Floor function:
WorksheetFunction.Floor(Arg1, Arg2)
Both arguments Arg1 and Arg2 need to be of the type double.
So you will need to use 1/24 instead of "1:00" (which is the same because 1 hour is 1/24 of a day) and a value .Cells(i, "A").Value instead of a cell reference name "A:A".
Also you will need a loop to achieve it for every used cell in the whole column A.
Option Explicit 'First line at your module ensures you declare any variables
Public Sub FloorFormat()
Dim lastRow As Long
With Worksheets("Sheet1") 'Your sheet name here
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row 'find last used row
Dim i As Long
For i = 1 To lastRow 'do the following for all used rows in column A
.Cells(i, "A").Value = Application.WorksheetFunction.Floor(.Cells(i, "A").Value, 1 / 24)
Next i
End With
End Sub
I hope you can help. I have a small piece of code below. The issue I am having is that I am trying to subtract today's date from the date in Column C (see Pic 1) and then return a numerical result in Column D and then continue this formula down Column D until there is no values left in column C to subtract against.
So today's date is 09/03/2017 I want to subtract this date from the date in C2 03/07/2017 giving me 2 in D2 and then continue this through column D until C has a blank cell.
The piece of code that is bugging is Range("D2").Formula = DateDiff(C2, Date, "d")
The error I get is run time error 13 type mismatch.
The larger piece of code it belongs to is
Public Sub Activate_Sheet()
Worksheets("In Progress").Activate
Columns.AutoFit
Range("N:N").EntireColumn.Delete
Range("D1").Value = "# days open"
Range("D2").Formula = DateDiff(C2, Date, "d")
End Sub
As always any and all help is greatly appreciated.
Pic 1
Instead of
Range("D2").Formula = DateDiff(C2, Date, "d")
use
Range("D2").Formula = "=DAYS(TODAY(),C7)"
.Formula has to be a formula as you write it into a cell (for english Excel versions). If you have a non-english (localized) Excel version then you can use .FormulaLocal to write formulas in your localized language.
DateDiff function Parameters:
Interval in your case "d" (represnting days), is the first parameter, not the third.
You can't use C2 inside the DateDiff function, but you need to get the value from that cell by using Range("C2").Value.
Also, DateDiff will return a Numeric result in days, so you need to enter it in Range("D2").Value and not Formula.
Modify your code to:
Range("D2").Value = DateDiff("d", Range("C2").Value , Date)
Edit 1: To run this code for all occupied cells in Column C:
Dim LastRow As Long, i As Long
With Worksheets("In Progress")
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
For i = 2 To LastRow
.Range("D" & i).Value = DateDiff("d", .Range("C" & i).Value, Date)
Next i
End With
I attached two links to a flowchart of how the VBA code should go about, and a screenshot of my two sheets.
Basically, I have two sheets - "Disbursements" & "Cheque Info". On the Disbursements' sheet, I need to consider only the rows with count > 1 (column I). For example, I won't consider row 8 of column I, but will consider row 12. Every row that has a count of > 1 should have a value on row H by the end of the run.
After considering which row has a count >1, we check if the corresponding amount (column F) is equal to Cheque Info's column E. Then if for example, for row 12 of disbursements, 1,384.35 is equal to row 9 of Cheque Info. We must get the difference of these dates then store it to a variable "Current". But there are many "1,384.35" that we must get the minimum difference for the dates, thus a need for a loop.
Again, I need to do loops for each row that has a count of >1 on disbursements' column I, so that I will get the date on Cheque Info (with the same amount) that has a minimum gap from the date on Disbursements sheet. For example, the date that has the least gap for 1/18/2016 (for the amount 1,384.35) is 1/4/2016.
Here is my current code:
Sub F110Loop()
Dim x As Integer 'current amount
Dim y As Integer
Dim d As Double 'delta between Disbursement date and Cheque Release date
Dim Current As Integer
Dim Least As Integer
Dim Dis As Worksheet
Dim Cheque As Worksheet
Dim wb As Workbook
Set wb = ThisWorkbook
Set Dis = wb.Sheets("Disbursements")
Set Cheque = wb.Sheets("Cheque Info")
wb.Activate
For x = 4 To 600
Do While Dis.Cells(x, 9).Value > 1
'IF same amount, get row number to get corresponding date, reference that date
For y = 3 To 600
If Dis.Cells(x, 6).Value = Cheque.Cells(y, 5).Value Then
'THEN get delta
Current = Dis.Cells(x, 4).Value -Cheque.Cells(y, 2)
'IF current is less than the least delta
ElseIf Current < Least Then
'THEN update new value of delta
Current = Least
Else
'copy paste the date (from the least delta row)
Cheque.Cells(y, 2).Copy Destination:=Dis.Cells(x, 8)
End If
Next y
Loop
Next x
End Sub
Your code hangs because you dont have any check s for null/vbnullstring or 0 values. i.e.:
IF Dis.Cells(x,6).Value <> vbNullString OR Dis.Cells(x,6).Value <> 0 Then....
reason this is needed is to keep excle from looping through each cell till out of memory...
Your Do Whileloop is an infinite loop. Once it catches a cell such that Dis.Cells(x, 9).Value > 1 it will loop forever, because inside the loop, nothing will change, neither x nor Dis.Cells(x, 9).Value.
I think you have to think again the logic of the subroutine. Maybe replacing that loop with a simple IF test would do.
The Do Loop will not exit until Dis.Cells(x, 9).Value > 1. Inside the Do Loop you change values in Dis.Cells(x, 8). If Dis.Range("I3:I600") does not have formulas in it or if anyone of the cells in Dis.Cells(x, 9).Value never exceed1 then theDo Loop` will never exit.
Do While Dis.Cells(x, 9).Value > 1
'IF same amount, get row number to get corresponding date, reference that date
For y = 3 To 600
Next y
Loop
You should also turn off ScreenUpdating while the code is running. If you don't need any formulas to recalculate then set Calculation to xlCalculationManual.
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Why are you using Range.Copy?
Cheque.Cells(y, 2).Copy Destination:=Dis.Cells(x, 8)
A direct assignment is much more effecient
Dis.Cells(x, 8) = Cheque.Cells(y, 2)
If there are no formula that you need to recalculate then using an array instead should cut you execution time to under 1 second.
How do you loop through the entire column and check if it is full year format or full date format and change every cell to full date format. For example, if a cell is 1832, how do you make it 1/1/1832 so the format is consistent throughout the column Q
Here is how you can do that.
Dim i As Integer
For i = 1 To Range("Q1").End(xlDown).Row
If Not IsDate(Cells(i, 17).Value) Then
Cells(i, 17).Value = "1/1/" & Cells(i, 17).Value
End If
Next i
IsDate function returns "true" if the passed value is a date. If the cell value is not a date, Concatenate "1/1" to the cell value. (17 represents column Q)