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
Related
At the end of every month, we copy/paste forecast sales (where the formulas are) as a hardcode into other columns for reference and reconciliation purposes.
For example, copy Column D (January) through Column F (march) into column Q (Jan hardcoded) through S (March hardcoded)
I'm trying to modify my code so the user can select from two data validation dropdowns which month range (e.g. Jan - Mar) on each of the forecast tabs to copy/paste as values.
For example, below is something I've added to copy/paste based on the # rows for a formula.
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Range("T1") = "PPU"
Range("T2") = "=S2/R2"
Range("T2").Copy
Range("T2:T" & LastRow).Select `dynamic row
Selection.PasteSpecial xlFormulas
Range("T:T").Copy
Range("T:T").PasteSpecial xlPasteValues
With my code above, is it possible to alter this so, instead of " & Lastrow", I keep the rows static but make the columns to copy variable, so for lack of a better term firstMonth & secondMonth.
The columns to select would be based off two named ranges where the user chooses from two data validation lists (firstMonth & secondMonth) with each column being assigned a column "letter" (e.g. Jan is column D, Feb Column E, etc.)
Without being dynamic, it would be something like:
Range("D12:F19").Copy
Range("Q12").PasteSpecial xlValues
But I'd like to have the user select with months, via a data validation list, to have hardcoded by choosing a beginning month (firstMonth) and ending month (secondMonth)
Something along the lines of:
Range(firstMonth &"12": secondMonth & "19").Copy `firstMonth in theory is the column letter so, "D12" and secondMonth is the second column letter (F12)
Range("pasteFirstMonth &"12").PasteSpecial xlValues `the firstMonth will be paired with the column letter, say "Q" where it will paste those values. A second column range isn't needed here since only the copied range will paste, not overlapping anything else. This is the "hardcoded" area.
Update: Slightly reconfigured Tim's answer below.
Sub copyColumns()
Dim months, m1, m2, sht
months = Split("Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec", ",")
Set sht = ActiveSheet
m1 = Application.Match(sht.Range("Month1").Value, months, 0)
m2 = Application.Match(sht.Range("Month2").Value, months, 0)
sht.Range(sht.Cells(8, 3 + m1), sht.Cells(16, 3 + m2)).Copy
sht.Range(sht.Cells(8, 16 + m1), sht.Cells(16, 16 + m2)).PasteSpecial xlValues
End Sub
Something like this should work:
Sub DoCopy()
Dim months, m1, m2, sht
months = Split("Jan,Feb,Mar,Apr,May,June,July,Aug,Sept,Oct,Nov,Dec", ",")
Set sht = ActiveSheet
m1 = Application.Match(sht.Range("Month1").Value, months, 0)
m2 = Application.Match(sht.Range("Month2").Value, months, 0)
If Not IsError(m1) And Not IsError(m2) Then
'copy range - use offset (3 here) depending on where months begin
sht.Range(sht.Cells(12, 3 + m1), sht.Cells(19, 3 + m2)).Copy
'etc
End If
End Sub
You can prompt the user for selecting the desired months and you can use the Selection object, like
Set rng=Selection
Cells(rng.row, rng.column) gives you the top left cell of the selection,
rng.Columns.Count gives you the number of columns, etc.
From a users perpective it is much easier to select an area on the screen and press a button than entering values or selecting them from list.
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 am really new to codes and Excel VBA, and hopefully, you guys could help me out with my question. Any tips, feedback, and comments are greatly appreciated!
Within a workbook, I want to make sure that my cell (I1) of worksheet (Sheet1) has the specific date as written in a different sheet (ie. Menu). I want I1 to be the starting point whereby subsequent dates will occur by going across the row (I1, J1, K1, etc.). In this case, if my specific date required is 15/8/16 and one of my sheet (Sheet 1) has its cell I1 written as 20/8/16, I want to know how to construct my code in such a way that,
If I1 in Sheet 1 is currently at 15/8/16, then do nothing. But if I1 in Sheet 1 is off a different later date than 15/8/16, the I1 will now begin at 15/8/16, and subsequent dates are added until it reaches the default date that was initially there at I1 (now 20/8/16 is at cell N1).
My current code is as follows:-
If ActiveSheet.Range("I1") <> MainSht.Range("D6") Then
ActiveSheet.Range("I1") = MainSht.Range("D6")
End If
Do
If Cells(1,z+1)>Cells(1,z+1) Then
Cells(1,z+1) = Cells(1,z)+1
End If
z = z+1
Loop Until Cells(1,z+1) = MainSht.Range("D7")
*Mainsht (D6) is my start date, (D7) is my end date.
My code currently does not have the insert column section because I have problems in applying both insert column and date increment code together. With my current code, my date range never expanded as it is still within the same earlier date range (same last column as before, hence last cell for date column remains as it is). How do I construct in such a way that the missing dates in between are added, and it is added by inserting columns in a repeated process?
Thanks in advance if anyone could help me out in this. Thanks for your understanding as well.
Please check below code to add columns
Dim start_date, end_date As Date
start_date = ThisWorkbook.Sheets("Sheet1").Range("L1").Value
end_date = ThisWorkbook.Sheets("main").Range("D7").Value
If start_date < end_date Then
Do Until start_date = end_date
ThisWorkbook.Sheets("Sheet1").Activate
Range("L:L").Insert (xlRight)
start_date = start_date + 1
Range("L1").Value = start_date
Loop
End If
you could try this:
Option Explicit
Sub main()
Dim diff As Long
With Worksheets("Work").Range("I1") '<--| reference working sheet range "I1" (change "Work" to your actual working worksheet)
diff = .Value - Worksheets("Menu").Range("D6") ' <--| evaluate the difference between referenced range value and worksheet "Menu" cell "D6" (change "Menu" to your actual "main" sheet)
If diff > 0 Then
With .Resize(, diff) '<-- reference referenced range resized to the necessary columns number
.EntireColumn.Insert xlRight '<-- insert columns
With .Offset(, -diff).Resize(1) '<--| reference referenced range first row
.FormulaR1C1 = "=RC[1]-1" ' <--| insert formulas that substracts one from the value of next cell on the right
.Value = .Value '<-- get rid of formulas
.NumberFormat = .Offset(, diff).Resize(, 1).NumberFormat '<--| format cells as the passed range
.EntireColumn.AutoFit '<--| adjust columns width
End With
End With
End If
End With
End Sub
Just change "Work" and "Menu" to your actual worksheets names
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)
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