Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
consolidate data that occurs close together in time
I have about 7 columns of data. The second one has about 150 different types
of components, about 2000 entries in all. the third column is the start date im looking for, the fourth is the start time. Fifth is the end date, Sixth is the end time. I am looking for a macro to go through each component, check the next component to see if its the same one, if it is, check the end date/time of the first one, and if it is within one day of the start time of the next entry, combine the two entries and delete the old ones. What I have so far is (This is kinda long, I apologize) Sub Compare_Dates() Dim CompRange As Range, CopyRange As Range Dim There As Boolean, This As Boolean Dim days As Date Dim Hours As Double There = False LastRow1 = Sheets("Sheet1").Cells(Cells.Rows.Count, "A").End(xlUp).Row Set CompRange = Sheets("Sheet1").Range("A2:A" & LastRow1) For Each c In CompRange If c.Value = c.Offset(1, 0).Value Then There = True End If If There Then days = c.Offset(0, 4).Value - c.Offset(1, 2).Value Hours = c.Offset(0, 5).Value - c.Offset(1, 3).Value If days + Hours <= 1 Then c.Offset(1, 2) = c.Offset(0, 2).Value c.Offset(1, 3) = c.Offset(0, 5).Value 'Need to check the date of c.offset(0,4) with c.offset(1,2) 'If they are within x days of each other 'c.offset(1,2).value=c.offset(0,2).value Else There = False If There Then If CopyRange Is Nothing Then Set CopyRange = c.Offset(1, 0).EntireRow Else Set CopyRange = Union(CopyRange, c.Offset(1, 0).EntireRow) End If End If 'This If loop checks if the CopyRange currently has any rows 'If not, it places c in it End If End If There = False Next If Not CopyRange Is Nothing Then CopyRange.Delete End If End Sub I think the only problem is comparing the dates, Other than that I feel like it should work. Any help with this macro, or any ideas for a different macro would be greatly appreciated! Thanks in advance, sorry for the long post!! |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
consolidate data that occurs close together in time
Before spending a lot of time on this because you suspect the comparison of
the Dates/times. Are the Hours entered as proper times on the worksheet. If so then dimension the Hours variable as a date and see what happens. Time in VBA are in fact dates. (Just a fraction of a day.) and the variables should be dimensioned as dates. -- Regards, OssieMac |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
consolidate data that occurs close together in time
Hmm... the hours are entered as proper time/format. For some reason it still
didnt to work. I got it to work in the end by just making a temporary column in excel that had the data computed already. functionally works perfectly now, just i wish it was fully automated. Thank you anyways for your time. "OssieMac" wrote: Before spending a lot of time on this because you suspect the comparison of the Dates/times. Are the Hours entered as proper times on the worksheet. If so then dimension the Hours variable as a date and see what happens. Time in VBA are in fact dates. (Just a fraction of a day.) and the variables should be dimensioned as dates. -- Regards, OssieMac |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
consolidate data that occurs close together in time
My apologies for not getting back to you sooner but I have been away.
I can follow your code and at this point I am not able to ascertain exactly what the problem is without the real data. One thing you might consider is assigning some of the date values to variables declared as double and place stops in your code and then when the code stops, hover the cursor over the double variables and see what they are returning. The following example of code shows just what can occur as you manipulate dates in VBA due to rounding of the nth decimal places and date/times that you think should be equal will not compare as equal. Sub testDateComparison() Dim dateFromWs As Date Dim dateFromStr As Date Dim timeFromStr As Date Dim dateCalculated As Date Dim dblOrigDate As Double Dim dblNewDate As Double Dim strDate As String Dim strTime As String 'Insert NOW() formula on worksheet Worksheets("Sheet1").Cells(2, 1).Formula = "=Now()" 'Get date and time from the worksheet dateFromWs = Worksheets("Sheet1").Cells(2, 1) 'Convert date and time to string format strDate = Format(dateFromWs, "dd mm yyyy hh:mm:ss") 'Convert string format date portion back to date dateFromStr = DateSerial(Year(strDate), Month(strDate), Day(strDate)) 'Convert stringformat time portion back to date timeFromStr = TimeSerial(Hour(strDate), Minute(strDate), Second(strDate)) 'Sum the new date and time dateCalculated = dateFromStr + timeFromStr dblOrigDate = dateFromWs dblNewDate = dateCalculated 'Compare the original date to the new date 'When converted to serial numbers both dates 'produce slightly different numbers. MsgBox "Original date time as Serial = " & _ dblOrigDate & vbCrLf & _ "New date and time as Serial = " & _ dblNewDate & vbCrLf & _ "Original date time as date = " & _ dateFromWs & vbCrLf & _ "New date and time as date = " & _ dateCalculated If dblOrigDate = dblNewDate Then MsgBox "Dates match" Else MsgBox "Dates do not match" End If Stop End Sub -- Regards, OssieMac |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Find a Value the first Time It Occurs | Excel Worksheet Functions | |||
Weekly Time Sheet Consolidate | Excel Worksheet Functions | |||
CountIF columnH2-H101 the number of time between ages 20-29 occurs | Excel Worksheet Functions | |||
formula to extract specific data if match occurs | Excel Worksheet Functions | |||
Can I have a loop to open a set of workbooks get some data, close it one a time. | Excel Programming |