Excel VBA script for loop with dates - vba

I am calculating the number of work hours (8am to 8pm) between the 2 given dates, excluding Weekends and Public holidays, but my code syntax is incorrect.
Sample data:
Start day: 17/06/2011 08:00:00 AM
End day: 19/06/2011 08:00:00 PM
Sub SLA_Days_Resolved_F()
Dim x As Integer
' Set numrows = number of rows of data.
NumRows = Range("F2", Range("F2").End(xlDown)).Rows.Count
Dim total As Integer 'to count the total hours
Dim st As String 'start date cell
Dim en As String 'end date cell
Dim destCell As String
Dim d As Date ' for the loop
total = 0
' Establish "For" loop to loop "numrows" number of times.
For x = 2 To NumRows + 1
st = "G" & CStr(x) 'reference to the cells
en = "D" & CStr(x)
'loop from start date to end date
For d = Date(Range(st)) To Date(Range(en))
'check if the current date is found is a Public holiday in the range or if a weekend
If ((Vlookup(d,lookups!$o$3:$p$26,2,false))=1) or (weekend(d))Then
'minus 8 to remove hours before 8am.
total = (total + Hour(d) + minutes(d) / 60) - 8
End If
Next
Next
End Sub

You are not assigning any values to variables st or en.
Date is not a function available in VBA. You will probably need to use DateSerial function. Here is a simple example of looping over dates which you should be able to modify.
Sub LoopDates()
Dim d As Date
'Loop the days beteween today and March 1, 2013.
For d = DateSerial(Year(Now), Month(Now), Day(Now)) To DateSerial(2013, 3, 1)
Debug.Print d 'Prints the "d" value in the immediate window.
Next
End Sub
Also, you can't just put worksheet formulae in VBA. This line is definitely wrong syntax for Vlookup, and Weekend is not a formula that I'm aware of (testing it seems to confirm it is not a valid call on worksheet or in VBA.
If ((Vlookup(d,lookups!$o$3:$p$26,2,false))=1) or (weekend(d))Then
Rewrite as:
If Application.WorksheetFunction.Vlookup(d,Sheets("lookups").Range("$o$3:$p$26"),2,false)=1 _
or Not Application.WorksheetFunction.Weekday(d) Then
ANOTHER EXAMPLE of a date loop where I have dimensioned the variables in what I believe to be a more efficient manner:
Sub Test()
Dim st As Range
Dim x As Integer
Dim stDate As Date
Dim enDate As Date
Dim d As Date
Dim numRows as Long
NumRows = Range("F2", Range("F2").End(xlDown)).Rows.Count
For x = 0 To NumRows-2
'SET YOUR VARIABLES HERE
' This may seem redundant or unnecessary for this case, but it makes structuring nested
' loops easier to work with, and then there are fewer places to make changes,
' if you need to make changes.
Set st = Range("G2").Offset(x, 0)
Set en = Range("D2").Offset(x, 0)
stDate = DateSerial(Year(st), Month(st), Day(st))
enDate = DateSerial(Year(en), Month(en), Day(en))
'Then, loop through the dates as necessary
For d = stDate To enDate
Debug.Print d
'Do your code here.
Next
Next
End Sub

Related

VBA Code to loop through a start and and end date and only paste weekdays

I have a code that I have written and its very basic so forgive me. In section 3, i need to basically autofill a date series but excludes weekends based on a start date and end date.
sh9 is the start date and sh10 is the end date so if sh9 was 10/12/2020 and sh10 is 10/22/2020, it would loop through but only paste weekdays for the 9 weekdays that occur between the two dates.
'3. Same date, Start time to End time 1 by 1
ws2.Range("BA" & rLoop + lr2).Value = ((sh9) + rLoop) + (Sh14)
ws2.Range("BB" & rLoop + lr2).Value = ((sh9) + rLoop) + (Sh15)
This is what the code might look like:-
Sub WriteWorkdayDates()
' 107
Dim Ws2 As Worksheet
Dim MyDate As Variant
Dim EndDate As Variant
Dim R As Long ' row number
Dim C As Long ' column number
Set Ws2 = ActiveSheet
R = 9
With Ws2
MyDate = .Cells(R, "SH").Value
EndDate = .Cells(R + 1, "SH").Value
If IsDate(MyDate) And IsDate(EndDate) Then
C = Columns("BA").Column
Do
MyDate = MyDate + 1
If MyDate > EndDate Then Exit Do
If WorksheetFunction.Weekday(MyDate) <> vbSunday And _
WorksheetFunction.Weekday(MyDate) <> vbSaturday Then
.Cells(R, C).Value = MyDate
C = C + 1
End If
Loop
End If
End With
End Sub
On review I find that I misunderstood your variables Sh9 and Sh10. Please feel with me on this subject because the same thing will happen to you when you review your code a year from now. That's why they always recommend to give "meaningful names". However, once you get used to my fetish for avoiding syntax intended for addressing ranges for the purpose of addressing cells you should find it easy to bend my code to your intentions.

Excel VBA - Conditional highlighting based on many criteria

I have a vba-created speadsheet with 4 sets of criteria. I need to highlight names at the bottom of the sheet based on whether or not they meet all the criteria.
I need the name to highlight if the analyst took 91 minutes or less of total break (B3:F9) each day, 15 minutes or less of tea break (B12:F18), and made at least 3 outbound calls each day (provided the staff time was 8 hours and 58 minutes or more (if it wasn't, the 3 call threshold does not apply)).
So, a function would be something like:
If
TtlB<91 mins & TeaB<15
& If
StfT <8:58:00 ignore ObC
Else If
StfT >8:58:00 & ObC>=3
Highlight (analyst name in A22:A28)
I know it will probably involve a nested loop or two, I just don't know where to get started. The loop for calculating "Total Minutes Owed" is below which can probably be modified to help me get started with this.
Dim i As Integer, j As Integer, k As Integer
j = 3
k = 12
For i = 22 To 28
Range("B" & i) = "=SUM(G" & j & ",G" & k & ")"
j = j + 1
k = k + 1
Next i
I'm pretty shure that a much more compact code can be done. But, since nobody answer you in the last four hours, try the following at least as an start.
Private Sub CommandButton1_Click()
Dim oWs As Worksheet
Dim rAnalysts As Range
Dim rBreak As Range
Dim rObC As Range
Dim rTea As Range
Dim rST As Range
Dim rRow As Range
Dim rIntersection As Range
Dim rCell As Range
Set oWs = Worksheets("MyData") 'The worksheet where data resides
MaxBreakTime = oWs.Cells(1, 7).Value 'The max break time. I set it in cell G1. Change according to your needs
Set rAnalysts = oWs.Rows("3:9") 'Define the rows for analysts
Set rBreak = oWs.Range("B:F") 'define the columns where Break data is placed
'(similarly, set ranges for tea break, etc)
For Each rRow In rAnalysts.Rows 'for each row in the analyst range
sAnalystName = oWs.Cells(rRow.Row, 1).Value 'get the name of the analyst
lBreakTime = 0 'restart this variable to zero
Set rIntersection = Application.Intersect(rRow, rBreak) ' intersect the row (the analyst) with the columns of the Break range
If rIntersection Is Nothing Then
MsgBox "Ranges do not intersect. Something is radically wrong."
Else
For Each rCell In rIntersection.Cells 'id est, friday through thursday
If rCell.Value > MaxBreakTime Then 'if break was longer that stipulated,....
lBreakTime = lBreakTime + rCell.Value - MaxBreakTime 'add the excess to the variable
End If
Next
End If
'write data somewhere (here, 30 rows down from original Analysts range)
oWs.Cells(rRow.Row + 30, 1) = sAnalystName
oWs.Cells(rRow.Row + 30, 2) = lBreakTime
If lBreakTime > 0 Then
oWs.Cells(rRow.Row + 30, 2).Font.Color = vbGreen
oWs.Cells(rRow.Row + 30, 2).Interior.Color = vbRed
End If
Next
'Here something similar for Tea break and Outbounds calls
'Since output is already writen, you can reuse variables like rIntersection or rCell
End Sub

Running a macro inside a specific date range

I have a macro that pulls info from several daily log sheets and compiles that info in a master workbook. In the same macro I manipulate the data so that it populates several charts and graphs. The problem that I have is the info would be most usefull if I could establish a date range that I wanted to look at and only pull that data. For exampl if I want to see the amount of scrap created by all machines from 9/9/14 to 11/9/14. Is there a way I could add this to the begining of my already created macro? The info I'm working with looks something like what I have below.
Machine Operator Date Production Scrap
A w 9/9/14 300 15
B x 9/9/14 400 0
C y 9/12/14 150 50
D z 10/9/14 200 3
This is tested. It will work with a table of changing lengths, and you can adapt the concepts in this to many needs. Have fun.
Sub ScrapCount()
Dim str_dateMin As String
Dim str_dateMax As String
Dim dateMin As Date
Dim dateMax As Date
Dim lastRow As Long
Dim subTotal As Double
Dim lookupDate As Date
Dim lRow As Long
lastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
subTotal = 0
str_dateMin = InputBox("Input beginning date, mm/dd/yyyy:")
str_dateMax = InputBox("Input end date, mm/dd/yyyy:")
dateMin = CDate(str_dateMin)
dateMax = CDate(str_dateMax)
For lRow = 2 To lastRow
lookupDate = Sheets("Sheet1").Cells(lRow, "C").Value
If dateMin <= lookupDate And lookupDate <= dateMax Then
subTotal = subTotal + Sheets("Sheet1").Cells(lRow, "E").Value
End If
Next lRow
MsgBox ("Total scrap for date range = " & subTotal)
End Sub
Very broad but here is what I would go with:
Beginning of macro calls a InputBox for date range (1 for start 1
for end) and stores as date variables)
Loop through rows and only
copy if value of date cell is within range of defined variables from
step 1

Excel: Enter dates in specific column

My requirement is:
I want to enter date from 1st Jan to 31st Jan in columns E5 to AI5. Currently using the below code which is not working.
Secondly year i m taking as user input which should change every time.
Sub LoopA()
Call Using_InputBox_Method
Dim i As Integer
Dim j As Integer
Dim PH As Integer
i = 5
For j = 5 To 35
Cells(i, j).Value = "=Date(E1,1,j)"
Next j
End Sub
Public Function Using_InputBox_Method() As Integer
Dim Response As Integer
' Run the Input Box.
Response = Application.InputBox("Enter a Year.", _
"Number Entry", , 250, 75, "", , 1)
' Check to see if Cancel was pressed.
If Response <> False Then
' If not, write the number to the first cell in the first sheet.
Worksheets(1).Range("E1").Value = Response
End If
Using_InputBox_Method = Response
End Function
A)
Anything within " will be considered as a String. So "=Date(E1,1,j)" is just a string. What you want, I guess is
"=Date(E1,1," & j & ")"
B)
For j = 5 To 35
Are you sure you want to go up till 35? The max you can have in any month is 31 :)
Syntax of =Date() is DATE(year,month,day)
Also you would need an additional check here to see if it is a valid date. For example 30th Feb will give you an error.
C)
InputBox should be avoided to accept dates. It can generate errors. You may want to use THIS. If you still want to use InputBox then you will have to do validations to ensure that there are no errors.
D)
Regarding, the Year changing automatically, You will have to increment the Year in Column E once the user automatically enters the date.
Is this what you are trying?
Sub Sample()
Dim Yr As Long, i As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
Yr = Application.InputBox("Enter a Year.", _
"Number Entry", , 250, 75, "", , 1)
'~~> Set it to whatever Year Range you want
If Yr < 1900 Or Yr > 9999 Then
MsgBox "Incorrect Year"
Exit Sub
End If
With ws
.Range("E1").Value = Yr
For i = 5 To 35
.Cells(5, i).Formula = "=Date(E1,1," & (i - 4) & ")"
Next i
End With
End Sub

How to split dates with VB in Excel

Facing such a problem when hadling with excels again...
I have an excel table with such cloumns
People Date
-------------------------
A 01/01/2013 - 05/01/2013
B 03/05/2013
C 08/06/2013
What I want to produce (For example A)
People Individual Date
-------------------------
A 01/01/2013
A 02/01/2013
A 03/01/2013
A 04/01/2013
A 05/01/2013
The year will be constant at 2013 and month are more or less kept constant as well.
Can someone give idea on how to achieve this?
Sub ExpandDates()
Dim rCell As Range
Dim i As Long
Dim vaDates As Variant
Dim rNext As Range
'Loop through the cells that contain dates or date ranges
For Each rCell In Sheet1.Range("B2:B4").Cells
'If there's a space, hyphen, space in the cell, it's a date range
If InStr(1, rCell.Value, " - ") > 0 Then
'Split the cell contents on space, hyphen, space
vaDates = Split(rCell.Value, " - ")
'Loop through the days of the range of dates
For i = CDate(vaDates(0)) To CDate(vaDates(1))
'Find the next blank cell in column E to record the results
Set rNext = Sheet1.Cells(Sheet1.Rows.Count, 5).End(xlUp).Offset(1, 0)
'Write column A to column E
rNext.Value = rCell.Offset(0, -1).Value
'Create a new date in column B using the month that the loop is currently processing
rNext.Offset(0, 1).Value = CDate(i)
Next i
'If no hyphen, it's just a date, so create one line in column E
Else
Set rNext = Sheet1.Cells(Sheet1.Rows.Count, 5).End(xlUp).Offset(1, 0)
rNext.Value = rCell.Offset(0, -1).Value
rNext.Offset(0, 1).Value = rCell.Value
End If
Next rCell
End Sub
Theory: Check the length of the cell. If the cell is longer than 10 characters, use the SPLIT function to get the 2 dates. Set the months equal to a variable, and do a loop based on those months to calculate the dates between them. You would probably store those dates in an array. Then write the array to the spreadsheet and move to the next cell to start the process over.
EDIT:
Sub prSplit()
If len(ActiveCell.Value) > 10 Then
Dim arr() As String
arr = Trim(Split(ActiveCell.Value, "-"))
For i = LBound(arr) To UBound(arr)
MsgBox arr(i)
Next
End If
End Sub
You can start with this and tweak the code until you get it. I just don't have the time to do the whole thing. Sorry. :o(