The code from Søren Holten Hansen under This post actually has part of my answer, but not completely.
I need to split dates along with their respective duration.
example:
Begin Date End Date Duration
3-Nov 5-Nov 2.5
I need it to look like this:
3-Nov 1
4-Nov 1
5-Nov 0.5
I need the half day to be shown on the last day. I am not sure how to make this split.
Appreciate the help this forum provides. This will really save my life!!!
my code:
ActiveCell.FormulaR1C1 = _
"=IF(AND(RC[-4]=R[-1]C[-4],RC[-4]=R[1]C[-4]),R[-1]C[-2]-R[-1]C, IF(R[-1]C[-2]=R[-1]C,R[-1]C[-2], R[-1]C[-2]))"
Range("E21").Select
Thank you,
Marvin.
Following code may help to solve your problem.
'Function print_date
' 1st argument: date of period begin
' 2nd argument: date of period end
' 3rd argument: duration in days
'
' CAUTION: This code does not check consistency between dates and duration.
' If you set duration 1.5 between Nov-3 to Nov-5, this code raise no error
' and you may see duration -0.5 on Nov-5.
Function print_date(beginDay, endDay, duration) As Integer
Dim aDay As Date
Dim row As Integer
row = 1
For aDay = beginDay To endDay
Cells(row, 1) = aDay 'set date on first column
If duration > 1# Then
Cells(row, 2) = 1 'set 1 on second column because more one day left.
Else 'Duration is less than one day
Cells(row, 2) = duration
End If
duration = duration - 1#
row = row + 1
Next aDay
End Function
' Test routine I checked operation of print_date.
Sub test_print_date()
Dim a As Long
a = print_date(DateValue("2014/11/03"), DateValue("2014/11/05"), 2.5)
End Sub
You may see the output on the cells A1:B3 when you run 'test_print_date()' of avobe code.
Related
I was looking for an answer however I failed.
I wrote following code that basically adds a new row to the table and adds a current week number in 1st cell of new row:
Set table = Workbooks("EMEA Day 2 Chasing Audit Master Report.xlsm").Worksheets("Team Stats").ListObjects.Item("TableLilla")
Set oLastrowStats = Workbooks("EMEA Day 2 Chasing Audit Master Report.xlsm").Worksheets("Team Stats").ListObjects("TableLilla").ListRows.Add
Worksheets("Team Stats").ListObjects("TableLilla").ListColumns(1).DataBodyRange(oLastrowStats.Index, 1).Value = "W" & WorksheetFunction.WeekNum(Now, vbMonday)
The weird part starts here: the code works as it should on 2 computers but it does not on third one. On the 3rd computer, new row is added but the 3rd code line doesn't insert a week number.
I'm pretty sure it is related with this particular notebook, however have no clue where to look for solution. I didn't notice any major differences in Excel Settings. I've also checked the Win10 regional and date set up and they are the same as on my notebook.
Do you have any clue how to sort this out?
Thanks!
Try using a function that returns the ISO 8601 week number (and year):
' Constants.
Public Const MaxWeekValue As Integer = 53
Public Const MinWeekValue As Integer = 1
Public Const MaxMonthValue As Integer = 12
Public Const MinMonthValue As Integer = 1
' Returns the ISO 8601 week of a date.
' The related ISO year is returned by ref.
'
' 2016-01-06. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function Week( _
ByVal Date1 As Date, _
Optional ByRef IsoYear As Integer) _
As Integer
Dim Month As Integer
Dim Interval As String
Dim Result As Integer
Interval = "ww"
Month = VBA.Month(Date1)
' Initially, set the ISO year to the calendar year.
IsoYear = VBA.Year(Date1)
Result = DatePart(Interval, Date1, vbMonday, vbFirstFourDays)
If Result = MaxWeekValue Then
If DatePart(Interval, DateAdd(Interval, 1, Date1), vbMonday, vbFirstFourDays) = MinWeekValue Then
' OK. The next week is the first week of the following year.
Else
' This is really the first week of the next ISO year.
' Correct for DatePart bug.
Result = MinWeekValue
End If
End If
' Adjust year where week number belongs to next or previous year.
If Month = MinMonthValue Then
If Result >= MaxWeekValue - 1 Then
' This is an early date of January belonging to the last week of the previous ISO year.
IsoYear = IsoYear - 1
End If
ElseIf Month = MaxMonthValue Then
If Result = MinWeekValue Then
' This is a late date of December belonging to the first week of the next ISO year.
IsoYear = IsoYear + 1
End If
End If
' IsoYear is returned by reference.
Week = Result
End Function
Like this:
Worksheets("Team Stats").ListObjects("TableLilla").ListColumns(1).DataBodyRange(oLastrowStats.Index, 1).Value = "W" & Week(Date)
how to write EXCEL VBA to make my date from 04/JUNE > 04/JUNE 23:59. i cannot use the '= date + 5/6' as i have to run the VBA many times a day and it will add my dates to tomorrow/ the day after tomorrow. i just wanna make the date to end of date. please help.
The example will be like
CELL A1 : 12/June
CELL B1 : 15/June
CELL C1 : 15/June 12:00 HRS
CELL D1 : =IF C1B2, “OUT OF RANGE”, “Okay !”)
in this case D1 will still display OUT OF RANGE.
I have loads of such to change so I was thinking of writing a VBA to automatically convert C1 from 15/JUNE -> 15/JUNE 23:59 , so that D1 will display Okay !
I tried Cdate(Range(“D1”)) + 5/6 in vba to make it 23:00 hrs and I run this macro a few times in a day and it will keep adding 23hrs to the date and made it change to another date.
About what you are talking?
About:
- "Excel Formula" or
- "EXCEL VBA"
?
About:
- "Comparing Range of Date" or
- "to make my date"
?
Assume, that VBA is...
The Date type in VBA is Double, where:
- Integer part as quantity of days from... (look F1), and
- Fractional part of day.
So, your desired "04/JUNE > 04/JUNE 23:59" will:
? DateSerial(2018, 06, 4) + ((23& * 60& * 60&) + (59& * 60&)) / 86400&
18-06-04 23:59:00
Yeah, sure, you can use TimeSerialinstead of above, but ... it didn't give you right understanding of VBA dates.
.
----------
ADD:
Sorry but will this code only work for one cell because I have lots of
cells with dates and I need VBA to extract them out and convert to
23:59 for eg I run a for loop to change like 20 cells in a row with
multiple range. And I will run the macro a few times in a day will it
add 23hrs to that date every time and cause it to change dates ?
Public Sub sp_Test_Date()
Dim rSel As Range
Dim i&
Const H23M59 As Double = 1 - 60 / 86400
Set rSel = Selection
With rSel
For i = 1 To .Cells.Count
With .Cells(i)
If IsDate(.Value) Then
.Offset(0, 1).Value = CDate(Int(.Value) + H23M59)
End If
End With ' .Cells(i)
Next
End With ' rSel
End Sub
i tried modifying it to below and it failed me :(
`
Dim x As Integer
Dim test1 As Date
Dim schdWS, compWS As Worksheet
Const H23M59 As Double = 1 - 60 / 86400
Set schdWS = Sheet1
Set compWS = Sheet11
lastrow = schdWS.Cells(Rows.Count, 8).End(xlUp).Row
For x = 20 To lastrow
If IsDate(schdWS.Cells(x, 3).Value) Then
Cells(x, 3).Value = CDate(Int(Cells(x, 3).Value + H23M59))
End If
'test1.NumberFormat = "dd/mm/yyyy"
'schdWS.Cells(x, 3).FormulaR1C1 = test1 & " 23:59"
Next x
End Sub
`
I am trying to model the cost of my home heating unit. I have 3.15 years of hourly data. I calculated cost per hour, cost per day, cost per month, and cost per year. I want to write two VBA function, one called CostPerDay and the other called CostPerMonth in order to simplify the process when I add more data. I have attached a picture of my data.
Picture of Data
The function I wrote for Cost Per Day is:
=SUM(OFFSET($M$18,(ROW()-18)*24,0,24,1))
The function I wrote for Cost Per Month is:
Jan-13 =SUM(OFFSET($P$18,(ROW()-18)*31,0,31,1))
Feb-13 =SUM(OFFSET($P$49,(ROW()-19)*28,0,28,1))
Mar-13 =SUM(OFFSET($P$77,(ROW()-20)*31,0,31,1))
Etc...
In case you need the whole range of data:
Cost Per Hour - M18:M27636
Cost Per Day - P18:P1168
Cost Per Month - S18:S55
Average Cost Per Month - V18:V29
This is what I was trying. As you can see, I am new to VBA. In the first attempt, I was trying to use Dim to define where the data was located in the spreadsheet and which cell I wanted the calculation in. I got stuck because I couldn't insert the =SUM(OFFSET($M$18,(ROW()-18)*24,0,24,1))function into VBA. I then was trying to make get rid of the hard-coded $M$18by replacing it with Cells(Match(Day,O18:O1168)+17,"P"). But none of it worked.
The second one I was playing with dialogue boxes, but I don't think I want to use them.
In the third attempt I was trying to calculate Cost Per Month. I don't have it because I didn't save it. I was using SUMIFSto match Months with the number of days in the month. That may have been my closest attempt but it still didn't work.
Function CostPerDay(BeginningCostPerDay, OutputCell)
Dim BeginningCostPerDay, OutputCell
BeginningCostPerDay = WorksheetFunction.DSum()
OutputCell = ActiveCell.Offset(3, -3).Activate
End Function
Function CostPerDay1()
Dim myValue1 As Variant, myValue2 As Variant
myValue1 = InputBox("Where do you want the data put?")
myValue2 = InputBox("What is the beginning Cost Per Day")
Range("myValue1").Value = myValue1
Range("myValue2").Value = myValue2
End Function
What if you added a helper column that started with 1 in cell A1 for example. Second row (A2) would be =If(A1=24,1,A1+1). Column B would have the hourly data. Column C or C1 would say =If(and(A1=24,A2=1),B1,B1+B2)). I didn't test, but I think this should work with perhaps a tweak.
Here's your answer.
Private Sub SumCosts(ByVal MainColumn As String, ByVal CostColumn As String, ByVal FirstDataRow As Long, Optional ByVal BracketType As Byte)
'
'Parameters:
'MainColumn: the columns with dates or months.
'CostColumn: the column that holds the costs to sum.
'FirstDataRow: the first row where the data starts
'BracketType: either 0 for hours or 1 for months
'
'This procedure assumes that in the data on the sheet
'- every hour of every day in the hours columns
'- every day of a month is present in the days columns
'are present. I.e. All hours of all 31 days of January are persent
'in the 'Date' column before the hours of February start and all days of January
'are present in the 'Month' column before the days of February start.
Const Hours As Byte = 24
'
Dim Cel As Range
Dim I As Long
Dim J As Long
Dim K As Long
Dim Rng As String
Dim Bracket As Byte
Dim Days As Byte
'
'Clean the target area, so the modle can be reused time after time.
Set Cel = Range(MainColumn & Application.Rows.Count).Offset(0, 1)
Rng = Split(Cel.Address, "$")(1)
Rng = (Rng & FirstDataRow & ":" & Rng & Cel.End(xlUp).Row)
Range(Rng).ClearContents
'
J = FirstDataRow
For Each Cel In Range(MainColumn & ":" & MainColumn)
If Cel.Value = vbNullString Then Exit For
If Cel.Row > (FirstDataRow - 1) Then
'Number of days in a month. Since this fluctuates the bracket fluctuates.
Days = DateSerial(Year(Cel.Value), Month(Cel.Value) + 1, 1) - DateSerial(Year(Cel.Value), Month(Cel.Value), 1)
Bracket = IIf(BracketType = 0, Hours, Days) 'Select the bracket to use.
K = ((Cel.Row - 1) * Bracket) + (FirstDataRow - 1) 'Determine where to stop calculating for a given day or month.
For I = J To K
Cel.Offset(0, 1).Value = Cel.Offset(0, 1).Value + Range(CostColumn & I).Value 'Do the calculation.
Next
J = K + 1 'Next loop we must pick up where we left off.
End If
Next
End Sub
Public Sub LaunchCostCalculations()
SumCosts "O", "M", 2, 0
SumCosts "R", "P", 2, 1
End Sub
Create a button in your sheet to launch LaunchCostCalculations and Bob's your uncle.
Object is to determine the highest number of channels (phone call channels) used during a 24 hour period, and then over a 7 day, and eventually over a few months period. This is needed to show us exactly how many MAXIMUM channels we are using in at any given peak time.
I would like to have a bar graph showing 1-100 in Y-axis and X-axis to be a 24 hour period or a 7 day or a 30 day etc...
Data sets we have are like this:
Date Phone-Number Time Duration(in seconds)
2014-01-01 415-444-7777 10:10 180
2014-01-01 415-444-6666 10:11 60
2014-02-01 415-222-1111 6:35 800
2014-03-01 415-444-5555 10:20 400
2014-03-01 415-444-4444 10:22 45
2014-05-01 415-222-1112 11:00 354
Above example shows that row1 and row2 have an overlap between 10:11 to 10:12 so we want to show this on bar graph as 2-channels being used and anything before or after that as 1-channel being used. Same thing can be said about row4 and row5.
Is this possible to do in Excel and if yes, how?
Thanks.
Google using a horizontal bar graph to create a gantt chart, where each bars length is the call start and stop time. You can calculate the stop time by adding the duration to the time with a formula like this:
TIMEVALUE("10:10:00 AM")+ TIME(0,0,180)
That gives you a start stop time by day for your chart.
On a worksheet you can use the formula to increment the time by one second so each row is a list of 1's representing the one second time increment in each column, then sum the 1's across the column to get the max number of channels for every second of overlap between calls.
The problem of counting overlapping seconds across multiple rows of calls requires a complex calculation that compares each second of a call against every second of all the other calls in the distribution to look for overlaps. (I solved a similar problem for looking for overlapping open long and short trades for the same security.)
Reply back if you want to tackle the latter.
I have rethought the approach and offer the below as the solution.
Set up three tabs named CallTimes, CallList, And ScratchPad.
CallList will be where your raw data is pasted. (Like the above)
CallTimes will be the counts of each second from 8:00 AM to 8:00 PM.
You can adjust the time range in the code.
ScratchPad will be used to create a record for every 1 second increment from each call time found on the call list. So 10:10 with a duration of 180 seconds will create 181 records on Scratchpad, then move on to row 2, etc.
When the macro stops CallTimes will have the counts in column 2. You can add a max, function or autofilter or graph from there.
'
' SetCallTimes - creates a list of call times 1 second apart from 8:00 to 8:00
'
'
Public Function SetCallTimes()
Dim dblTime As Double
Dim i As Integer
Dim tWS As Worksheet
Dim sWS As Worksheet
Dim ScratchPad As Worksheet
Dim aCell As Range
Dim lRow As Long
Dim sTimer As Single
Dim strMsg As String
Debug.Print Now()
With Application
.Calculation = xlCalculationManual
' .ScreenUpdating = False
End With
With ActiveWorkbook
Set tWS = .Sheets("CallTimes")
Set sWS = .Sheets("CallList")
Set ScratchPad = .Sheets("ScratchPad")
End With
With tWS.UsedRange
.ClearContents
.ClearFormats
.Range("A1").Value = "Time"
.Range("B1").Value = "Count"
End With
'Set start time
dblTime = TimeValue("8:00:00")
For i = 0 To (60 * 60 * 8)
tWS.Range("A" & i + 2).Value = "'" & Format(DateAdd("s", i, dblTime), "HH:MM:SS")
tWS.Range("B" & i + 2).FormulaR1C1 = "=COUNTIFS(ScratchPad!C[-1],RC[-1])"
Next i
With ScratchPad.UsedRange
.ClearContents
.ClearFormats
End With
With ScratchPad
.Range("A1").Value = "Time"
.Range("B1").Value = "Source"
.Range("C1").Value = "DurationSecond"
End With
'F is the column with the starttime, G has the duration
lRow = 1
For Each aCell In Intersect(sWS.Range("F1").EntireColumn, sWS.UsedRange.Offset(1, 0))
For i = 0 To aCell.Offset(0, 1).Value
lRow = lRow + 1
ScratchPad.Range("A" & lRow).Value = "'" & Format(DateAdd("S", i, aCell.Value), "HH:MM:SS")
ScratchPad.Range("B" & lRow).Value = aCell.Address
ScratchPad.Range("C" & lRow).Value = i
Next i
Next aCell
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
Debug.Print Now()
MsgBox "Load Call Times Done"
End Function
You can adjust the columns read in the code (currently F & G which I used for testing purposes. There is a more elegant solution using an array in code, which would run faster, but I had difficulty with Excels rendering of seconds which made matching on the decimal value (e.g. 0.3334837963 for 8:00:13) so I went with the lazy approach. The value of using an array vs. listing time apart from speed is the ability to only report the top-n values once the array is populated. If you love puzzles and get a sense of accomplishment from solving them think about how you might use a two dimensional array to increment the values for each second of the day. It's a fun challenge for those of us with apparently too much free time on our hands. ;-)
Enjoy.
Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 8 years ago.
Improve this question
I have an Excel Workbook with 4 sheets in my hand. Each sheet contains daily data for a stock. Each sheet contains 3 columns: the first column lists "Date": 1/6/04 - 6/20/14. The 2nd column is the daily return of this stock recorded on each day. The 3rd column is the daily volume of this stock.
I want to compile the data in the four sheets to just one sheet with 9 columns: 1st column is the date. 2nd&3rd columns contain the return & volume of the 1st stock; 4th&5th columns have the return & volume of the 2nd stock; 6th&7th for the 3rd stock and 8th & 9th for the last stock. In other words, the data of the four stocks would be listed on the same sheet by "Date".
One problem: the first stock has 2692 trading days recorded, yet the 2nd has only 2638 trading days. The 3rd and 4th stocks both have 2633 days recorded. And, for example, on 5/13/2009, only the 1st and the 4th stocks were traded (with data available), but the 2nd and 3rd stocks do not have data, so 5/13/2009 is not included in the 2nd and 3rd sheet of the raw data file. But I want this date to be included in my final (compiled) data sheet because on this day, at least one stock is available.
Eventually, I wish my final sheet to have all the dates when any stocks were traded. For all the missing data (or missing spots), I wish the cells to be filled with NaN.
How can I achieve this in excel VBA/Macro? I also use R so any coding advice with R on this problem would also help.
Thanks.
This is just an outline (I hope the SO police don't shoot me).
Can you get started with this?
Sub Main()
do ' this is the outer loop
for sheet = 1 to 4
get the lowest unselected date
next sheet
if all sheets are done, then exit sub
for sheet = 1 to 4
get either data or NaN for the selected date
next sheet
loop
End Sub
EDIT: ' (I don't know what "on hold" does) This should be a good model for using arrays. (I'll do anything for 15 points.) I've made many assumptions. You don't need to change dates into integers to compare.
Option Explicit
Sub Demo()
Dim iSheet&, aSheets(2) As Worksheet, Outsheet As Worksheet
Dim iRow&(2), iLastRow&(2), outRow&, iCol1&, iCol2&, Date1$, selectedDate$
Set aSheets(1) = ThisWorkbook.Sheets("adam")
Set aSheets(2) = ThisWorkbook.Sheets("bill")
Set Outsheet = ThisWorkbook.Sheets("zack")
iLastRow(1) = 3: iLastRow(2) = 4 ' ending rows
iRow(1) = 1: iRow(2) = 1 ' starting rows
outRow = 1
Do ' this is the outer loop
selectedDate = "12/31/9999" ' starting date (high)
For iSheet = 1 To 2
If iRow(iSheet) <= iLastRow(iSheet) Then
Date1 = aSheets(iSheet).Cells(iRow(iSheet), 1)
If Date1 < selectedDate Then selectedDate = Date1
End If
Next iSheet
If selectedDate = "12/31/9999" Then Exit Sub ' no more
Outsheet.cells(outRow, 1) = selectedDate
For iSheet = 1 To 2
iCol1 = iSheet * 2 ' output columns
iCol2 = iCol1 + 1
If iRow(iSheet) <= iLastRow(iSheet) Then
Date1 = aSheets(iSheet).Cells(iRow(iSheet), 1)
If Date1 = selectedDate Then
Outsheet.Cells(outRow, iCol1) = aSheets(iSheet).Cells(iRow(iSheet), 2)
Outsheet.Cells(outRow, iCol2) = aSheets(iSheet).Cells(iRow(iSheet), 3)
iRow(iSheet) = iRow(iSheet) + 1 ' next row
Else
Outsheet.Cells(outRow, iCol1) = "na"
Outsheet.Cells(outRow, iCol2) = "na"
End If
End If
Next iSheet
outRow = outRow + 1
Loop
End Sub