I have a workbook that is used to schedule the next upcoming task on a job. each row has 28 cells, each cell represents a day of the week within the 4 weeks lookahead. I made a formula to check the date of the cell with the start and end date of the task and fill the cell accordingly.
Here is the formula:
=IFERROR(IF(AND(ISNUMBER(SEARCH("Delivery",$D16)),VALUE(F$10)=VALUE('Calculation
New'!$AO53)),"D",IF(AND(ISNUMBER(SEARCH('Calculation
New'!$BH$13,$AJ16)),VALUE(F$10)>=VALUE('Calculation
New'!$AO53),VALUE(F$10)<=VALUE('Calculation
New'!$AP53)),"N",IF(AND(ISNUMBER(SEARCH('Calculation
New'!$BH$12,$AJ16)),VALUE(F$10)>=VALUE('Calculation
New'!$AO53),VALUE(F$10)<=VALUE('Calculation
New'!$AP53)),"E",IF(AND(VALUE('Calculation
New'!$AO53)=VALUE('Calculation New'!$AP53),F$10='Calculation
New'!$AO53,NOT(ISNUMBER(SEARCH('Calculation
New'!$BH$9,$D16)))),"SF",IF(AND(ISNUMBER(SEARCH('Calculation
New'!$BH$9,$D16)),VALUE(F$10)>=VALUE('Calculation
New'!$AO53),VALUE(F$10)<=VALUE('Calculation
New'!$AP53)),"I",IF(AND(VALUE(F$10)>VALUE('Calculation
New'!$AO53),VALUE(F$10)<VALUE('Calculation
New'!$AP53)),"X",IF(VALUE(F$10)=VALUE('Calculation
New'!$AO53),"S",IF(VALUE(F$10)=VALUE('Calculation
New'!$AP53),"F","")))))))),"")
a few things to that formula:
D16:D85 on the sheet "SIS" is the Task description where to look for certain words
BH9 on sheet "Calculation New" contains a word to compare to. The range of words is BH3:BH13
F10:AF10 on the sheet "SIS" contains the date for the cells below of the day of the week
AO53:AO122 on sheet "Calculation New" contains the start date of a task
AP53:AP122 on sheet "Calculation New" contains the End date of a task
currently, I got 70 Rows times 28 cells and each cell has this formula in it. Now I want to rather use a VBA code do the same thing, but I am having a hard time to get started. I am not very experienced with VBA. I researched in regards to nesting For each loop but so far I am not succeeding.
I would appreciate any help I can get.
Thank you in advance
Dan
here is the code I have written so far not complete but I am stuck and need some advice
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim SDate As Range
Dim EDate As Range
Dim WDate As Range
Set SDate = Worksheets("Calculation New").Range("SDate")
Set EDate = Worksheets("Calculation New").Range("EDate")
Set WDate = Worksheets("Calculation New").Range("WDate")
For SDate = 1 To Worksheets("Calculation New").Range("SDate").End(xlDown) 'lenght of range varies
'For WDate = 1 To 28 ' length is always same
'If cell = WDate Then 'i want to compare each cell of WDate with the start date
'cell = "X"
'Next
Next
End Sub
To get you started with VBA, you might want to start here. There's a lot of questionable sites offering VBA code but this is directly from Microsoft and covers the basics. Happy coding!
https://learn.microsoft.com/en-us/office/vba/library-reference/concepts/getting-started-with-vba-in-office
For loops can be tricky - generally you can start with an array saying r = ActiveSheet.UsedRange and loop through it
Sub nestedLoop()
r = ActiveSheet.UsedRange
For i = LBound(r) To UBound(r)
For j = LBound(r, 2) To UBound(r, 2)
'evaluate r(i,j) do something
'Debug.print r(i,j)
Next j
Next i
End Sub
Related
Worksheet1:
Excel sheet
New
Worksheet 1 has licences with 6 columns of information - two being the start and end date.
I need a method of extracting all the records that are within 90 days before the expiry date- the idea being I want a separate alert page
I have done a IF statement that is on the end of the columns that just prints 1 if date is hits the alert criteria or 0 if not...The idea now in Worksheet2 I need some sort of VLOOKUP and IF to extract those records automatically.
How would I do this?
=IF(IFERROR(DATEDIF(TODAY(),H5,"d"),91)<90,1,0)
While use of Pivot table or VBA macro is recommended in such cases, if you absolutely need to use the formula then you may use the below trick.
You already have the Binary column. Now, add another column say Cumulative Binary that will sum all the 1's till the current row using a SumIf formula as shown in the screenshot below (it is fine if some numbers are repeated because of 0's)
The formula in I3 in my workbook is
=SUMIF(H$3:H3,1,H$3:H3)
and you may adjust it as per your needs.
Now, it is easy since each row has a unique number, we could use Vlookup or like I have done here i.e. use Offset function which simply matches the value in the "Lookup Column" to the value in "Cumulative Binary" column and returns the rows that match.
=IFERROR(OFFSET($F$2,MATCH(M3,$I$3:$I$9,0),0,1,2),"")
Please note that it is an array formula as I need to return multiple columns (2 here). So, I selected two columns N,O as shown in the screenshot wrote the formula and used Ctrl+Shift+Enter (instead of Enter). Then I simply dragged the formula down. You may want to adjust it as per your needs by including more columns.
If you can use VBA, you may write some code like this:
Option Explicit
Public Sub CopyCloseToExpiration()
Dim rngSource As Range: Set rngSource = ThisWorkbook.Worksheets("Sheet1").Cells(2, 1).Resize(LastRow(ThisWorkbook.Worksheets("Sheet1")) - 1, 9)
Dim rngDestinationTopLeft As Range: Set rngDestinationTopLeft = ThisWorkbook.Worksheets("Sheet2").Cells(LastRow(ThisWorkbook.Worksheets("Sheet2")) + 1, 1)
Dim datLimit As Date: datLimit = DateAdd("d", 90, Date)
CopyBeforeDate rngSource, rngDestinationTopLeft, datLimit
End Sub
Public Sub CopyBeforeDate(rngSource As Range, rngDestinationTopLeft As Range, datLimit As Date)
Dim lngOffset As Long: lngOffset = 0
Dim rngRow As Range: For Each rngRow In rngSource.Rows
If rngRow.Cells(1, 8).Value < datLimit Then
rngDestinationTopLeft.offset(lngOffset, 0).Resize(rngRow.Rows.Count, rngRow.Columns.Count).Value = rngRow.Value
lngOffset = lngOffset + 1
End If
Next
End Sub
Public Function LastRow(ewsSheet) As Long
With ewsSheet
Dim lngResult As Long: lngResult = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
LastRow = lngResult
End Function
You have to put the above into a new Module, customize it (e.g. replace "Sheet1" with the name of you worksheet's actual name), and run it (You can place the caret on the sub CopyCloseToExpiration and hit F5 or place a button somewhere and call this function from its event handler).
So, right now I have this excel sheet where there is a last revision date. I have named this column "LastRevisionDate". And then I have a column named "RevisionFrequency" . The "RevisionFrequency" contains a drop-down menu consisting of terms, "Annually", "Bi-Annually"(2 times in a year), "Semi-Annually", and "Quarterly". And then I have a column where it states the "NextRevisionDate". So I want to create a VBA code that would calculate the NextRevisionDate from the LastRevisionDate and the RevisionFrequency.
For example. Say in column "A" i have the RevisionFrequency to be "Bi-annually" And the last revision date was Mar-14 in column "B", then I would want the NextRevisionDate in column "C" to state Mar,Sep .Thats basically saying that the item gets revised twice a year. So I would want to create a macro where Column "C" is based off the RevisionFrequency and LastRevisionDate. I realize I could do this with a formula, but I have new items being added constantly so I do not want to keep copying formulas into each cell. Also for some items, they do not need revision, I would also like to have a blank cell if there is no LastRevisionDate.
So far, I have this updated code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Set ws = Sheets(1)
If Not Intersect(Target, ws.Range("LastCalDate").Value) Is Nothing Then
Dim Lastdate As Date
Dim DueDate As Variant
Dim Frequency As String
Dim R As Variant
Dim C As Variant
Dim R1 As Variant
Dim C1 As Variant
Dim R2 As Variant
Dim C2 As Variant
R = Range("LastCalDate").Row
C = Range("LastCalDate").Column
R1 = Range("CalDueDate").Row
C1 = Range("CalDueDate").Column
R2 = Range("CalFrequency").Row
C2 = Range("CalFrequency").Column
Lastdate = Cells(R, C).Value 'Last Cal Date
DueDate = Cells(R1, C1).Value 'Cal Due Date
Frequency = Cells(R2, C2)
If Frequency = "Annually" Then
DueDate = DateAdd("mmm", 12, Lastdate)
End If
If Frequency = "Semi-Annually" Then
DueDate = DateAdd("mmm", 6, Lastdate)
End If
If Frequency = "Quarterly" Then
DueDate = DateAdd("mmm", 3, Lastdate)
End If
End Sub
“Am I just overcomplicating my code?”
That is the wrong question. The first question is not “What can I do?” but “What do my users want?”
If you start by saying “I can produce wooden clogs”, you may never learn they want soft slippers. You may not be able to produce soft slippers but you can probably produce something a lot better than wooden clogs if know it is required. Start with the design of the ideal product then cut it down to what is practical.
From your description, I visualise something like this:
You may have many other columns and these three columns may be in different positions; it does not matter, we will restrict ourselves these columns for now.
It sounds to me as though you have two requirements and an issue:
You have a worksheet where the values in the Next Revision Date column may be unreliable or missing. You require a macro that will run down the existing worksheet and enter correct values into the Next Revision Date column.
You have a requirement to set the values in the Next Revision Date column automatically as new rows are added of existing Revision Frequencies and Last Revision Dates are amended. This could be achieved by running macro 1 or using the Worksheet Change event, as you suggest. There may be other approaches but I will not address this requirement.
If you look at the last three rows of my example worksheet, you will notice the day of the month in the Next Revision Date column is not the same as that in the Last Revision Date. This is because I converted the value in the Frequency column to 3, 6 or 12 and added that number of months to the Last Revision Date. In the last three rows the new month does not have as many days as the old and the VBA function has, for example, converted 30 February to 2 March. Is this the effect you require? I have included code to bring the date back to the “correct” month. Often the most difficult task in macro design is identifying all these exceptions and specifying how they are to be handled.
I will only consider macro 1 first since you can use it for both requirements while you are design and implementing macro 2. If you run into problems with macro 2, ask a new question. You can ask as many questions as you like – providing they are good questions – but they should only be one issue per question.
You need a macro that will step down every row of the worksheet. If you are using an online tutorial or you have bought a book on Excel VBA, you may find a suitable example there. If you are using neither an online tutorial nor a book, please start. It will not take long to master the basics of Excel VBA and the time spent learning the basics will quickly repay itself. Trying to search the web for code when you do not know the basics is very difficult.
If your tutorial/book does not tell you how to step down every row of the worksheet, try searching SO for “[excel-vba] find last row of worksheet”. There are lots of variations of this question so you should have no difficulty in finding something suitable. You do not have to do so on this occasion because I show you how below but I believe this is the best way of using this site. Break your requirement down into little steps and then search for a question relevant to each step.
Below is a simple macro 1. Study my code and come back with questions if necessary. However, the more you can understand on your own, the faster you will develop.
Welcome to the joys of programming.
Option Explicit
' Using constants for values that may change makes your code easier to
' understand and easier to maintain.
Const ColFrequency As Long = 1
Const ColLastRevisionDate As Long = 2
Const ColNextRevisionDate As Long = 3
Const RowDataFirst As Long = 2
Sub FixNextRevisionDate()
Dim DateLastCrnt As Date
Dim DateNextCrnt As Date
Dim NumMonthsToStep As Long
Dim RowCrnt As Long
Dim RowLast As Long
' Replace "Data" with the name of your worksheet
With Worksheets("Data")
' This is the most popular method of finding the last row but it will
' not work in every situation. I believe it is appropriate for your
' current requirement but suggest you look for questions that describe
' other methods and which explain why they might be better.
RowLast = .Cells(Rows.Count, ColFrequency).End(xlUp).Row
For RowCrnt = RowDataFirst To RowLast
' Convert Frequency to 3, 6 or 12
' I have used the LCase function to allow for inconsistent use of
' upper and lower case
Select Case LCase(.Cells(RowCrnt, ColFrequency).Value)
Case "annually"
NumMonthsToStep = 12
Case "bi-annually"
NumMonthsToStep = 6
Case "semi-annually"
NumMonthsToStep = 6
Case "quarterly"
NumMonthsToStep = 3
Case Else
' Unknown frequency. never assume the worksheet is correct
' if an error will cause your macro to fail.
' This is an easy way to highlight faulty values for user
' attention.
With .Cells(RowCrnt, ColFrequency)
.Interior.Color = RGB(255, 0, 0)
NumMonthsToStep = 0
End With
End Select
If NumMonthsToStep <> 0 Then
' Had valid frequency
If IsDate(.Cells(RowCrnt, ColLastRevisionDate).Value) Then
' Value in Last Revision Date column is a date
DateLastCrnt = .Cells(RowCrnt, ColLastRevisionDate).Value
' Calculate next date by adding NumMonthsToStep
DateNextCrnt = DateSerial(Year(DateLastCrnt), _
Month(DateLastCrnt) + NumMonthsToStep, _
Day(DateLastCrnt))
' You may not want this but it shows how to do it if you do
If Day(DateNextCrnt) < Day(DateLastCrnt) Then
DateNextCrnt = DateSerial(Year(DateNextCrnt), _
Month(DateNextCrnt), _
0)
End If
With .Cells(RowCrnt, ColNextRevisionDate)
.Value = DateNextCrnt
' Replace with date format of your choice
.NumberFormat = "d mmm yy"
End With
Else
' The Last Revision Date is not a date
With .Cells(RowCrnt, ColLastRevisionDate)
.Interior.Color = RGB(255, 0, 0)
End With
End If
End If
Next
End With
End Sub
I'm very new to VBA in excel and I've tried searching for my question already.
I'm trying to calculate an answer based off the value of the cell and have the calculated value replace the current value upon macro execution. For example if A2 has an initial value of 30 I'd like too replace A2 with =A2*3 so that A2 would read 90 as its new value.
Is there any way to do this without having to copy and paste everything somewhere else first?
Thanks for any help.
Try something like this. First, make sure you have selected at least one cell, and then run the macro from the macros menu:
Sub MultiplyBy30()
Dim rng as Range
Dim cl as Range
Set rng = Range(Selection.Address)
For each cl in rng.Cells
If IsNumeric(cl.Value) And Len(cl.Value) > 0 Then
cl.Formula = "=" & cl.Value & "*30"
End If
Next
End Sub
I have a sheet of data and am attempting to check column E10 TO I610 to see if the values in there are more than 11538 and the value in cell J5 is "weekly". If the conditions are true, add the values that are more than 11538 and multiply them by 8.4. How do I go about doing this?
Not too strong with vba so please bear with me.
If schedType = "Weekly" And Range("E10,I610").Value > 11538 Then
Range("H6").Value = "WOW"
ElseIf schedType = "Monthly" Then
Range("H6").Value = "10"
End If
I tried the above way to achieve what I want. Though the code above wont do the exact calculations im after, its just a test. Like I said, I'm attempting to search the range E10 to I610 for any values greater than 11538, then total them and finally find 8.4% of the total.
Its a bit complicated and any assistance is greatly appreciated.
This doesn't work for a lot of reasons, not the least of which is this:
Range("E10,I610").Value
For starters, Range("E10,I610") is a range of only two cells, you guessed it: E10 and I10. Use a colon to create a continuous range object, Range("E10:I610"). Furthermore, the .Value property of a multi-cell range will always, only return the value in the top, left cell.
So, since the value of E10 was not > 11538, the first If statement returns False, and the rest of your code within that block is omitted.
Then, it will continues to fail because you have not structured the code correctly.
There are several ways to work with multiple cells/ranges, I will give you one example which is not very efficient, but it will work for your purposes. I will use a For each loop to iterate over every cell in the Range("E10:I610"), and then check those values against 11538, summing the values greater than 11538.
Sub TotalCells()
Dim schedType as String
Dim rng as Range
Dim cl as Range
Dim myTotal as Double
Set rng = Range("E10:I610")
schedType = Range("J5").Value
'## Check what schedType we are working with:
If schedType = "Weekly" Then
For each cl in rng.Cells
If cl.Value > 11538 Then myTotal = myTotal + cl.Value
Next
'## Multiply the sum by 8.4%
myTotal = 0.084 * myTotal
'## Display the result:
MsgBox "The weekly total is: " & myTotal, vbInformation
ElseIf schedType = "Monthly" Then
' You can put another set of code here for Monthly calculation.
End If
## Print the total on the worksheet, cell H6
Range("H6").Value = myTotal
End Sub
As I said, this is not efficient, but it illustrates a good starting point. You could also use formulas like CountIfs or SumIfs or use the worksheet's AutoFilter method and then sum the visible cells, etc.
In the future, it is always best to post all, or as much of your code as possible, including the declaration of variables, etc., so that we don't have to ask questions like "What type of variable is schedType?"
I'm making this more challenging in my head than it has to be, but since I haven't been using vba or excel recently I'm using this as my excuse. Please don't question the methodology :) as this is only a small step I'm trying eliminate for someone to save some time, until I can redo the entire process. I would do the reverse, but this is an invoice of sorts that they are using....
I'm thinking macro or function is what is needed and not a formula since the data on worksheet 2 will change each month and there is no date I can reference.
What I'd like to do:
I have a cell on worksheet 2 that will change once a month. I want to place the value of the cell from Worksheet 2 into a cell in worksheet 1 each month that she changes it.
Each month would be represented in column A and the value of the cell from Worksheet 2 during that month needs to be place in column B.
Column A Column B
12/5/2012 $3,459,877.81
1/8/2013 $9,360,785.62
2/8/2013
3/8/2013
4/8/2013
So when she changes worksheet 1 for February the number will populate next to 2/8 and so on. I was thinking do it when she saves the document, or make it a shortcut she can hit or just scrap it and tell her it's not worth.
Giving a Cell a name to reference from you can do some neat stuff with the Target parameter passed to the Worksheet_Change function:
'Add this function to the sheet that has the cell being
'+changed by the user (Sheet 2)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim strCellName As String
strCellName = "ChangeMe"
'If the cell we changed was the ChangeMeCell
If Target.Address = Sheet2.Range(strCellName).Address Then
'Store value
Dim intLastRow, intValue As Integer
intValue = Range(strCellName).Value
'Find the cell in Sheet 1 Column A that matches this month
intLastRow = Sheet1.Range("A:A").End(xlDown).Row
For Each cl In Sheet1.Range("A1:A" & intLastRow).Cells
'Ensure cell value is date
If IsDate(cl.Value) Then
'If date is today's date
'Note that Math.Round(<date>, 0 ) essentially removes the time
'+from any date value so #01/02/03 04:05:06# becomes #01/02/03#
If Math.Round(cl.Value,0) = Math.Round(Now,0) Then
'Update column B's value
Sheet1.Range("B" & cl.Row).Value = intValue
End If
End If
Next
End If
End Sub
This assumes you have the sheet layout with the "invoice values" in Sheet1 and the cell being changed in Sheet2. You need to give that cell a name.
Using the cell Name box to the left of the Function bar call the cell that changes "ChangeMe" or anything you wish to change it to, update that cell name in the first line of the function and this function will do all the rest.
It is important to note that the dates must be correctly formatted for your systems region. to make sure it is showing the right month - format them into LongDate so you can see them as 08 March 2013 instead of 03/08/13 which may get confusing the longer it goes on. Speaking as a British programmer, dates are the bane of my life!
Edit: I have update the code to compare the dates by the full date minus the time, instead of the previous monthly comparison, if you still need to subtract or add a month to either date value, just use the DateAdd("m", <date>, <value>) to add or subtract the month.
Edit: DatePart Function page is a useful resource for those wanting to know more about DatePart()
For my example, I'm using cell G4 as the one that will be updated by your coworker. You have to have some way to persist the original value of G4 in order to tell when it's been changed. The easy way to do this is to pick some cell that is out of sight of the user and store the number there so you can reference it later. Here I've chosen cell AA1. The following code must be added specifically to Sheet2 since it needs to monitor the changed events on that sheet only so it can fire when G4 is updated.
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("G4") <> Range("AA1") Then
Dim lastRow As Long
Range("AA1") = Range("G4")
lastRow = Worksheets("Sheet1").UsedRange.Rows.Count
Worksheets("Sheet1").Cells(lastRow + 1, 1).Value = Date
Worksheets("Sheet1").Cells(lastRow + 1, 2).Value = Range("AA1")
End If
End Sub
Keep in mind that this is a very "quick and dirty" approach for this task, as there are no error handlers or much flexibility in the way it works.
EDIT --
One other method you could use is referenced here, and can simply check to see if a given cell has changed, without verifying the difference in value.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("G4"), Range(Target.Address)) Is Nothing Then
Dim lastRow As Long
Range("AA1") = Range("G4")
lastRow = Worksheets("Sheet1").UsedRange.Rows.Count
Worksheets("Sheet1").Cells(lastRow + 1, 1).Value = Date
Worksheets("Sheet1").Cells(lastRow + 1, 2).Value = Range("AA1")
End If
End Sub
Now, I'm able to capture the value from a formula in the cell and place it in a different cell in another worksheet. Here's my final product:
Private Sub Worksheet_Calculate()
Dim strCellName As String
strCellName = "ChangeMe"
If Sheets("Application of Moneys").Range(strCellName).Address <> PrevVal Then
Dim intLastRow, intValue As Long
intValue = Range(strCellName).Value
'Find the cell in Sheet 1 Column A that matches this month
intLastRow = Sheets("Certificate 1").Range("B:B").End(xlDown).Row
For Each cl In Sheets("Certificate 1").Range("B13:B25" & intLastRow).Cells
'Ensure cell value is date
If IsDate(cl.Value) Then
'If date is today's date
'Note that Math.Round(<date>, 0 ) essentially removes the time
'+from any date value so #01/02/03 04:05:06# becomes #01/02/03#
If DatePart("m", cl.Value) = DatePart("m", Now()) Then
'Update column B's value
Sheets("Certificate 1").Range("H" & cl.Row).Value = intValue
End If
End If
Next
End If
End Sub