if column F is in this date format then column K should have this code CD else error msg box my code is below does not seem to work for different date format setting in that column pls help
Sub date_check3()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet6")
Dim lr As Long, Target As Range
lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For Each Target In ws.Range("F2:F3" & lr & ",K2:K3" & lr)
If Target.NumberFormat = "mm/dd/yyyy h:mm:ss AM/PM" And Target.Offset(0, 5) <> "CD" And Target <> "" Then
MsgBox "Error" & Target.Address
End If
Next Target
End Sub
What do you mean by "does not seem to work for different date format setting"?
Your condition asks for a specific format: Target.NumberFormat = "mm/dd/yyyy h:mm:ss AM/PM"
To check if the value in a cell looks like a date in an arbitrary format, you could use following line:
If IsDate(Target) And Target.Offset(0, 5) <> "CD" And Target <> "" Then
You loop range is wrong. You just need to loop through one column. Also, since you are looping through Column F, you should update your lr calculation to check that columns range.
lr = ws.Range("K" & ws.Rows.Count).End(xlUp).ROw
For Each Target In ws.Range("F2:F" & lr)
+ last row worksheet reference updating
Related
I'm having the following columns in Excel: Document Date (all cells have values) & Initial Disposition Date (there're blanks within the column).
Each Document Date cell corresponds to an Initial Disposition Date cell.
For any blank Initial Disposition Date cells, I'd like to set them to be 7 days from the corresponding Document Date. (Strictly blank cells)
Ex: Document Date = 10/01/2018. Desired Initial Disposition Date = 10/08/2018.
Is there a code to execute such action? (I have approximately 55,000 rows and 51 columns by the way).
Thank you very much! Any suggestions or ideas are highly appreciated!
Looping through a range is a little quicker in this case. I am assuming your data is on Sheet1, your Document Date is on Column A and your Initial Deposition is on Column B.
Last, you need to determine if you want that 7 days to be inclusive of weekends or not. I left you a solution for both. You will need to remove one of the action statements (in middle of loop)
Option Explicit
Sub BetterCallSaul()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim LRow As Long, iRange As Range, iCell As Range
LRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
Set iRange = ws.Range("B2:B" & LRow)
Application.ScreenUpdating = False
For Each iCell In iRange
If iCell = "" Then
iCell = iCell.Offset(, -1) + 7 'Includes Weekends
iCell = WorksheetFunction.WorkDay(iCell.Offset(, -1), 7) 'Excludes Weekends
End If
Next iCell
Application.ScreenUpdating = True
End Sub
If your Document Date is on Column A and you Initial Disposition Date in Column B, then the following would achieve your desired results:
Sub foo()
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set the worksheet you are working with, amend as required
Lastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
For i = 2 To Lastrow
'loop from row 2 to the last row with data
If ws.Cells(i, "B").Value = "" Then
'if there is no value in Column B then
ws.Cells(i, "B").Value = ws.Cells(i, "A").Value + 7
'add seven days to the date from Column A
End If
Next i
End Sub
A formula on all blanks would avoid the delays looping through the worksheet column(s).
Sub ddPlus7()
Dim dd As Long, didd As Long
With Worksheets("sheet1")
'no error control on the next two lines so those header labels better be there
dd = Application.Match("Document Date", .Rows(1), 0)
didd = Application.Match("Desired Initial Disposition Date", .Rows(1), 0)
On Error Resume Next
With Intersect(.Columns(dd).SpecialCells(xlCellTypeConstants, xlNumbers).EntireRow, _
.Columns(didd).SpecialCells(xlCellTypeBlanks).EntireRow, _
.Columns(didd))
.FormulaR1C1 = "=rc[" & dd - didd & "]+7"
End With
On Error GoTo 0
End With
End Sub
I would like to insert the formula which calculate only 1st day of everymonth (1.Nov.2017, 1.Dec.2017 etc.) at the end of E row and drag it till the end which equal to values of D row. I used the code below but not working.
I need Value in "E12 : E21 " as 01.Nov.2017 only if A:D have data. But A:D will be automatically calculated. For next month A22 :D24 will contain data. So i need values in "E22: E24 " as 01. Dec.2017. Help me
Private Sub CommandButton1_Click()
Range("E" & Rows.Count).End(xlUp).Offset(1, 0).Select
Run FirstDayInMonth()
Selection.AutoFill Destination:=Range("D" & Column.count).End(xlUp).Offset(0, 1), Type:=xlFillCopy
End Sub
Function FirstDayInMonth(Optional dtmDate As Date = 0) As Date
Range("E" & Rows.Count).End(xlUp).Offset(1, 0).Select
If dtmDate = 0 Then
dtmDate = Date
End If
FirstDayInMonth = DateSerial(Year(dtmDate), _
Month(dtmDate), 1)
End Function
At first, you overuse Select. It should be use in the code in one case only - if you want macro to point certain cell at the end. See this article, for example.
Secondly, avoid Smart UI antipattern. What is Smart UI, you can read here:
Third, I think you should use sub, not function here.
Sub FillFirstDay(Optional dtmDate As Double = 1)
Dim ws As Worksheet
Dim rng As Range
Dim lastRow As Long, firstRow As Long
Set ws = ActiveSheet 'You should assign your sheet here, for example by name
'Then we find our range in E column
With ws
lastRow = .Range("D" & .Rows.Count).End(xlUp).Row
firstRow = .Range("E" & .Rows.Count).End(xlUp).Row + 1
Set rng = Range(.Range("E" & firstRow), .Range("E" & lastRow))
End With
If firstRow >= lastRow Then Exit Sub
'And finally add first date of month
With rng
.Value = DateSerial(Year(dtmDate), Month(dtmDate), 1)
.NumberFormat = "yyyy-mm-dd" 'or whatever date format do you like
End With
End Sub
The line If firstRow >= lastRow Then Exit Sub terminates the procedure when dates in column E are already filled.
Perhaps I'm missing a reason that this has to be done in a complicated fashion, but can't you just use a worksheet function?
You want Column E to show a date (the 1st of the month) in rows where there's data?
Put this into cell E2 (or all of column E if you want), either directly or programmatically (with WorksheetFunction):
=IF(D2="","",DATE(YEAR(NOW()),MONTH(NOW()),1))
Modified formula:
I going to use a formula in VBA to compare to columns of data and if a match is found then enter some data from one sheet to another. I have used a formula on the first row and this works I get the desired results, I want to automate it as this will be part of other automations on the report. I have got some code which enters a column heading then applies the sumif function to the entire column but I get the same results all the way down, it is the results for the first row.
Code
Sub ImportCosting()
Dim z As Workbook
Dim x As Workbook
Set x = Workbooks.Open("C:\Documents\Reports\MEP.xlsx")
With Workbooks("MEP")
Worksheets("DynamicReport").Range("P5").Value = "Budget"
Worksheets("DynamicReport").Range("Q5").Value = "Forecast"
End With
Set z = Workbooks.Open("C:\Documents\Reports\Budget.xlsx")
With x.Worksheets("DynamicReport")
lastRow = .Cells(Rows.Count, 5).End(xlUp).Row
For Each rng In .Range("P6:P" & lastRow)
rng.Formula = "=SUMIF('[Budget.xlsx]DynamicReport'!$C:$C,$B6,'[Budget.xlsx]DynamicReport'!H:H)"
rng.Value = rng.Value
Next rng
End With
End sub
Hope I have explained the problem correctly. Can anyone tell me where I have gone wrong and how to get it so that the sumif function is applied to each row and not the results for the first row repeated.
Thanks
I am not sure but I guess you want to change the B6 to the rng.row
I guess you are getting the same result in every cell of rng because you are putting B6 as the criteria for sum so change that to the corresponding row number in the B column so that you get the desired result.
Change this:
rng.Formula = "=SUMIF('[Budget.xlsx]DynamicReport'!$C:$C,$B6,'[Budget.xlsx]DynamicReport'!H:H)"
to this
rng.Formula = "=SUMIF('[Budget.xlsx]DynamicReport'!$C:$C,$B" & rng.Row & ",'[Budget.xlsx]DynamicReport'!H:H)"
pls try below
Sub ImportCosting()
Dim z As Workbook
Dim x As Workbook
Set x = Workbooks.Open("C:\Documents\Reports\MEP.xlsx")
With Workbooks("Bank.xlsx")
Worksheets("DynamicReport").Range("P5").Value = "Budget"
Worksheets("DynamicReport").Range("Q5").Value = "Forecast"
End With
Set z = Workbooks.Open("C:\Documents\Reports\Budget.xlsx")
With x.Worksheets("DynamicReport")
lastRow = .Cells(Rows.Count, 5).End(xlUp).Row '"E"
For Each Rng In .Range("P6:P" & lastRow)
Rng.Formula = "=SUMIF([Budget.xlsx]DynamicReport!$C:$C,[Budget.xlsx]DynamicReport!$B$" & Rng.Row & ",[Budget.xlsx]DynamicReport!H:H)"
'Rng.Value = Application.WorksheetFunction.SumIf(z.Worksheets("DynamicReport").Range("C:C"), z.Worksheets("DynamicReport").Range("B" & Rng.row), z.Worksheets("DynamicReport").Range("H:H"))
Rng.Value = Rng.Value
Next Rng
End With
End Sub
I'm trying to add a Vlookup piece to a long macro that I'm working on to eliminate some daily data manipulation work.
Essentially everyday I have four new columns of data that I compare to the day befores, using vlookup. The four new columns sit in columns C-F and the old data in columns M-P. I vlookup column D against column M, with the formula in column G.
I'm running into a problem of how to be flexible with the range I give the macro to use each day as I don't want to constantly change it. The amount of rows will fluctuate between 10,000-30,000.
Here is my code- I'm probably thinking about this all wrong.
Sub Lookup()
Dim i, LastRow
Set i = Sheets("data").Range("F5").End(xlUp)
If Cells(i, "F5").Value <> "" Then
Range(i, "G").Value = WorksheetFunction.VLookup(Cells(i, "D"), Range("N").End(xlDown), 1, False)
End If
End Sub
Give this a go
Sub Sheet2_Button1_Click()
Dim Rws As Long, rng As Range, Mrng As Range, x
Rws = Cells(Rows.Count, "D").End(xlUp).Row
Set rng = Range(Cells(1, "G"), Cells(Rws, "G"))
Set Mrng = Range("M1:M" & Rws)
rng = "=IFERROR(VLOOKUP(D1, " & Mrng.Address & ",1,0),""Nope"")"
'----------If you want it to be just values uncomment the below line--------------
' rng.Value=rng.Value
End Sub
You have some backwards range references. I can't speak to the vlookup call, but you can start by looking at this part:
If Cells(i, "F5").Value <> "" Then
Range(i, "G").Value = WorksheetFunction.VLookup(Cells(i, "D"), Range("N").End(xlDown), 1, False)
End If
Try changing it to this to fix the range declarations:
If Range("F" & i).Value <> "" Then
Range("G" & i).Value = WorksheetFunction.VLookup(Range("D" & i), Range("N").End(xlDown), 1, False)
End If
I have a script that is converting a Julian Date to a Gregorian Date. I am supposed to be able to click on a range that contains my Julian Date, then select on a range where I'd like to insert my Gregorian Date. The only problem is that once I set the first selected range as JD (Julian Date), I can't seem to assign a new selected range.
For instance if I select B:B as my range of JD, then JD = 2.
Then if I select D:D for my range of GD (Gregorian Date), then GD should = 4, but it still equals 2. I'm not sure what else is going to error out after I get through with this part, but I'm stuck here for now. Can anyone provide any insight? Any help is appreciated!
Sub Julian_to_Gregorian()
Dim rng As Range, col As Range, cols As Range, arr
Dim sht As Worksheet, shet As Worksheet, hdr As Long, yn As Long, LastRow As Long
Dim dest As Range
On Error Resume Next
Set rng = Application.InputBox( _
Prompt:="Please select the column that contains the Julian Date. " & vbNewLine & _
" (e.g. Column A or Column B)", _
Title:="Select Julian Date Range", Type:=8)
On Error GoTo 0
jd = Selection.Column
'pjd = jd.Column
hdr = MsgBox("Does your selection contain a header?", vbYesNo + vbQuestion, "Header Option")
Set dest = Application.InputBox( _
Prompt:="Please select the column that the Gregorian Date will be placed in. " & vbNewLine & _
"(A new column will be inserted in this location, preserving the current data in this location.)", _
Title:="Select Destination Range", Type:=8)
gd = Selection.Column
If dest Is Nothing Then Exit Sub
'gd = Selection.Column
Set sht = dest.Parent
Set shet = rng.Parent
On Error GoTo 0
'yn = MsgBox("Do you want to insert a new column here?" & vbNewLine & _
' "(Choosing 'No' will replace the current cells in your selected range." & vbNewLine & _
' "All data in this range will be permanently deleted.)", vbYesNo + vbQuestion, "Destination Range Options")
LastRow = shet.Cells(Rows.Count, jd).End(xlUp).Row
Application.ScreenUpdating = False
'With Range(Cells(1, 3), Cells(1, 2 + Range("B1"))).EntireColumn
With Cells(1, gd).EntireColumn
.Insert Shift:=xlToRight
End With
'gd.EntireColumn.Insert xlRight
gd = gd - 1
For i = 2 To LastRow
Cells(i, gd).Value = "=DATE(IF(0+(LEFT(" & Cells(i, jd) & ",2))<30,2000,1900)+LEFT(" & Cells(i, jd) & ",2),1,RIGHT(" & Cells(i, pjd) & ",3))"
Next i
End Sub
I did not test the rest of your code, but to get the correct columns:
replace
jd = Selection.Column with jd = rng.Column
replace
gd = Selection.Columnwith gd = dest.Column
The reason your code didn't work was simple: The selection you activate during your prompts are no "real" selections in the sheet, they are only valid for the prompt. After the prompt, the selection from before the prompts will be active again and thus, jd and gd would always be equal to the column of the cell selected before executing the macro.