Naresh Patel
asked on
Data Convertion
Hi Experts,
I want to modify my code which take care of time between 9:15 AM To 15:30 PM to convert 1 min data to 15 min data.
currently it exclude data 15:30 PM onwards but not before 9:15 AM.
Thanks
Data-Convert-V03.xlsm
I want to modify my code which take care of time between 9:15 AM To 15:30 PM to convert 1 min data to 15 min data.
currently it exclude data 15:30 PM onwards but not before 9:15 AM.
Thanks
Data-Convert-V03.xlsm
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
@Rgonzo1971
Just to be fair I tested this sample data and your routine fails. Just not competing here but trying to optimize wasted time for asker !!!
gowflow
Data-Convert-V04-rgonzo.xlsm
Just to be fair I tested this sample data and your routine fails. Just not competing here but trying to optimize wasted time for asker !!!
gowflow
Data-Convert-V04-rgonzo.xlsm
ASKER
Excellent
@gowflow
Tks for the remark but it fails only if you run the macro from the 15 min Sheets but since the user has a button on Sh 1 Min I used it as reference
And it seems that my code is 3times quicker since I only loop the data once with the same end result.
corrected Version
Regards
Tks for the remark but it fails only if you run the macro from the 15 min Sheets but since the user has a button on Sh 1 Min I used it as reference
And it seems that my code is 3times quicker since I only loop the data once with the same end result.
corrected Version
Sub Convert_1to15_Rgonzo1971()
Dim WS As Worksheet
Dim WSConv As Worksheet
Dim MaxRow As Long, MaxRowConv As Long, FirstLine As Long, IdxLine As Long
Dim StRow As Long, EndRow As Long
Dim BgnTime As Variant, EndTime As Variant
Application.ScreenUpdating = False
Set WS = Sheets("1 Min ")
MaxRow = WS.UsedRange.Rows.Count
'---> Check if Sheet 15 Min there
On Error Resume Next
Set WSConv = Sheets("15 Min")
If Err <> 0 Then
Worksheets.Add after:=Worksheets(Worksheets.Count)
Set WSConv = ActiveSheet
WSConv.Name = "15 Min"
WS.Range("1:1").Copy WSConv.Range("A1")
WS.Range("A:A").Copy
WSConv.Range("A1").PasteSpecial xlPasteFormats
MaxRowConv = 2
Application.CutCopyMode = False
Else
WSConv.Rows("2:" & Rows.Count).EntireRow.ClearContents
MaxRowConv = WSConv.UsedRange.Rows.Count + 1
End If
On Error GoTo 0
BgnTime = WS.Range("I6")
EndTime = WS.Range("J6")
FirstLine = 2
IdxLine = 2
Do
Do While (TimeValue(WS.Range("A" & FirstLine)) < BgnTime Or _
TimeValue(WS.Range("A" & FirstLine)) > EndTime)
FirstLine = FirstLine + 1
If WS.Cells(FirstLine, 1) = "" Then
MsgBox "Done!"
Exit Sub
End If
Loop
IdxLine = FirstLine
Do While ((CLng(Mid(TimeValue(WS.Range("A" & IdxLine)), 4, 2)) + 1) Mod 15 <> 0 And _
TimeValue(WS.Range("A" & IdxLine)) < EndTime)
IdxLine = IdxLine + 1
Loop
WSConv.Cells(MaxRowConv, "A") = WS.Cells(IdxLine, "A")
WSConv.Cells(MaxRowConv, "B") = WS.Cells(FirstLine, "B")
WSConv.Cells(MaxRowConv, "C") = WS.Application.WorksheetFunction.Max(WS.Range("C" & FirstLine & ":C" & IdxLine))
WSConv.Cells(MaxRowConv, "D") = WS.Application.WorksheetFunction.Min(WS.Range("D" & FirstLine & ":D" & IdxLine))
WSConv.Cells(MaxRowConv, "E") = WS.Cells(IdxLine, "E")
WSConv.Cells(MaxRowConv, "F") = WS.Application.WorksheetFunction.Sum(WS.Range("F" & FirstLine & ":F" & IdxLine))
MaxRowConv = MaxRowConv + 1
FirstLine = IdxLine + 1
Loop While WS.Cells(FirstLine, 1) <> ""
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub
Regards
ASKER
@Rgonzo1971 I had change code but getting error message.
HI
Pls try Example
I am not getting any error ( Could you explain Which error you are getting?)
Regards
Data-Convert-V05.xlsm
Pls try Example
I am not getting any error ( Could you explain Which error you are getting?)
Regards
Data-Convert-V05.xlsm
@Rgonzo1971
Sorry Just saw the post was at lunch.
I am sorry but you are wrong in your assumptions. The file I posted has only 1 sheet which is 1 Min and has only your code there.
Run it and you get an error.
I strongly suggest you test your code prior to posting as it is our duty to provide Askers a tested code as not always Askers knows how to test code.
Regards
gowflow
Sorry Just saw the post was at lunch.
I am sorry but you are wrong in your assumptions. The file I posted has only 1 sheet which is 1 Min and has only your code there.
Run it and you get an error.
I strongly suggest you test your code prior to posting as it is our duty to provide Askers a tested code as not always Askers knows how to test code.
Regards
gowflow
This is the file you posted !!! with some more data at the end day
Same error !!!!
gowflow
Data-Convert-V05-rgonzo.xlsm
Same error !!!!
gowflow
Data-Convert-V05-rgonzo.xlsm
@gowflow
Thank you for your remarks but it works perfectly on my computer, I do not understand yet why it doesn't on yours or the itjockey's
I did test the code
I suppose TimeValue is the source of the problem but don't know why.
@itjockey
I won't post any comment on this question after this
Best Regards
Thank you for your remarks but it works perfectly on my computer, I do not understand yet why it doesn't on yours or the itjockey's
I did test the code
I suppose TimeValue is the source of the problem but don't know why.
@itjockey
I won't post any comment on this question after this
Best Regards
what version of Excel are you using ?
gowflow
gowflow
ASKER
Me Excel 2010 Professional 32 Bit.
Thanks
Thanks
I meant Rgonzo1971
gowflow
gowflow
@gowflow
Office Professional 2010 Plus
but it may be a localization problem (German version) however time is the same in EN version as in the German one ("hh:mm:ss")
Regards
Office Professional 2010 Plus
but it may be a localization problem (German version) however time is the same in EN version as in the German one ("hh:mm:ss")
Regards
Well it is not localization it is your logic that is wrong. Well didn't want to go thru this but seems you insist that your logic is fine well here it is:
If I debug I get for this:
Mid(TimeValue(WS.Range("A" & IdxLine)), 4, 2) ---> "5:"
meaning that you went on a wrong foot assuming that the minutes are at the fourth character as it is clear in the whole file that you have
9:15
9:16
etc...
10:15
10:16
10:21
etc..
until 10 you are at position 3 for the minutes and after that you are at position 4
For your loop to work regardless you should force formatting and instead of this
you should have this:
gowflow
If I debug I get for this:
Mid(TimeValue(WS.Range("A"
meaning that you went on a wrong foot assuming that the minutes are at the fourth character as it is clear in the whole file that you have
9:15
9:16
etc...
10:15
10:16
10:21
etc..
until 10 you are at position 3 for the minutes and after that you are at position 4
For your loop to work regardless you should force formatting and instead of this
Do While ((CLng(Mid(TimeValue(WS.Range("A" & IdxLine)), 4, 2)) + 1) Mod 15 <> 0 And _
TimeValue(WS.Range("A" & IdxLine)) < EndTime)
you should have this:
Do While ((CLng(Mid(Format(TimeValue(WS.Range("A" & IdxLine)), "hh:mm"), 4, 2)) + 1) Mod 15 <> 0 And _
TimeValue(WS.Range("A" & IdxLine)) < EndTime)
gowflow
@gowflow
Thank you very much
The difference is due to the Windows Setting for Time
You have probably H:MM:SS and I have HH:MM:SS
By changing the setting I can recreate the error.
Learning every day...
Regards
Thank you very much
The difference is due to the Windows Setting for Time
You have probably H:MM:SS and I have HH:MM:SS
By changing the setting I can recreate the error.
Learning every day...
Regards
ASKER
Salutes both of you.....i like it. :-)
Well for sure we learn every day !!! that is my moto anyway.
Cheers
gowflow
Cheers
gowflow
Just for reference my code using Split instead of Mid ( if only I would have done it sooner)
Sub Convert_1to15() ' Version 5
Dim WS As Worksheet
Dim WSConv As Worksheet
Dim MaxRow As Long, MaxRowConv As Long, FirstLine As Long, IdxLine As Long
Dim StRow As Long, EndRow As Long
Dim BgnTime As Variant, EndTime As Variant
Application.ScreenUpdating = False
Set WS = Sheets("1 Min ")
MaxRow = WS.UsedRange.Rows.Count
'---> Check if Sheet 15 Min there
On Error Resume Next
Set WSConv = Sheets("15 Min")
If Err <> 0 Then
Worksheets.Add after:=Worksheets(Worksheets.Count)
Set WSConv = ActiveSheet
WSConv.Name = "15 Min"
WS.Range("1:1").Copy WSConv.Range("A1")
WS.Range("A:A").Copy
WSConv.Range("A1").PasteSpecial xlPasteFormats
MaxRowConv = 2
Application.CutCopyMode = False
Else
WSConv.Rows("2:" & Rows.Count).EntireRow.ClearContents
MaxRowConv = WSConv.UsedRange.Rows.Count + 1
End If
On Error GoTo 0
BgnTime = WS.Range("I6")
EndTime = WS.Range("J6")
FirstLine = 2
IdxLine = 2
Do
Do While (TimeValue(WS.Range("A" & FirstLine)) < BgnTime Or _
TimeValue(WS.Range("A" & FirstLine)) > EndTime)
FirstLine = FirstLine + 1
If WS.Cells(FirstLine, 1) = "" Then
MsgBox "Done!"
Exit Sub
End If
Loop
IdxLine = FirstLine
Do While ((CLng(Split(TimeValue(WS.Range("A" & IdxLine)), ":")(1)) + 1) Mod 15 <> 0 And _
TimeValue(WS.Range("A" & IdxLine)) < EndTime)
IdxLine = IdxLine + 1
Loop
WSConv.Cells(MaxRowConv, "A") = WS.Cells(IdxLine, "A")
WSConv.Cells(MaxRowConv, "B") = WS.Cells(FirstLine, "B")
WSConv.Cells(MaxRowConv, "C") = WS.Application.WorksheetFunction.Max(WS.Range("C" & FirstLine & ":C" & IdxLine))
WSConv.Cells(MaxRowConv, "D") = WS.Application.WorksheetFunction.Min(WS.Range("D" & FirstLine & ":D" & IdxLine))
WSConv.Cells(MaxRowConv, "E") = WS.Cells(IdxLine, "E")
WSConv.Cells(MaxRowConv, "F") = WS.Application.WorksheetFunction.Sum(WS.Range("F" & FirstLine & ":F" & IdxLine))
MaxRowConv = MaxRowConv + 1
FirstLine = IdxLine + 1
Loop While WS.Cells(FirstLine, 1) <> ""
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub
@Rgonzo1971
While checking your routine, although found an error in your about the date due to windows setting, also do not hide that I found that you reported in sheet 15 Min 914 records while I was reporting only 913.
So looking further into this noticed that my loop was missing the last item !!! :(
I guess we are even !!
@ITjockey
If you decided to use my macro please disregard the previous version and use the below as it was missing the last item.
Tks Rgonzo1971, helped me catch a fault in mine.
Here is the new code and the attached file has the changes incorporated.
ITJockey sorry for inconvenience.
Gowflow
Data-Convert-V06.xlsm
While checking your routine, although found an error in your about the date due to windows setting, also do not hide that I found that you reported in sheet 15 Min 914 records while I was reporting only 913.
So looking further into this noticed that my loop was missing the last item !!! :(
I guess we are even !!
@ITjockey
If you decided to use my macro please disregard the previous version and use the below as it was missing the last item.
Tks Rgonzo1971, helped me catch a fault in mine.
Here is the new code and the attached file has the changes incorporated.
Sub Convert_1to15()
Dim WS As Worksheet
Dim WSConv As Worksheet
Dim MaxRow As Long, MaxRowConv As Long, I As Long, J As Long, Incr As Long, StandardIncr As Long
Dim StRow As Long, EndRow As Long
'---> Disable Events
With Application
.EnableEvents = False
.ScreenUpdating = False
.DisplayAlerts = False
End With
'---> CleanDataNotInTimeFrame
CleanDataNotInTimeFrame
Set WS = Sheets("Temp")
MaxRow = WS.Range("A" & WS.Rows.Count).End(xlUp).Row
'---> Check if Sheet 15 Min there
On Error Resume Next
Set WSConv = Sheets("15 Min")
If Err <> 0 Then
Worksheets.Add after:=Worksheets(Worksheets.Count)
Set WSConv = ActiveSheet
WSConv.Name = "15 Min"
WS.Range("1:1").Copy WSConv.Range("A1")
WS.Range("A:A").Copy
WSConv.Range("A1").PasteSpecial xlPasteFormats
WSConv.Range("A1").Select
End If
MaxRowConv = 2
On Error GoTo 0
StandardIncr = 14
Incr = StandardIncr
'---> Start Process
For I = 2 + Incr To MaxRow + Incr
If I <> 2 + StandardIncr Then
'---> Check to see if Current set of dates falls all within the same date
If WS.Cells(I, "A") = "" Then
J = I
Do
J = J - 1
Incr = Incr - 1
Loop Until IsDate(WS.Cells(J, "A"))
I = J
Else
If DateValue(WS.Cells(I - Incr, "A")) <> DateValue(WS.Cells(I, "A")) Or WS.Cells(I, "A") = "" Then
J = I - Incr
Do
J = J + 1
Loop Until DateValue(WS.Cells(I - Incr, "A")) <> DateValue(WS.Cells(J, "A"))
Incr = J - 1 - (I - Incr)
I = I - StandardIncr
Else
Incr = StandardIncr
End If
End If
End If
WSConv.Cells(MaxRowConv, "A") = WS.Cells(I, "A")
WSConv.Cells(MaxRowConv, "B") = WS.Cells(I - Incr, "B")
WSConv.Cells(MaxRowConv, "C") = WS.Application.WorksheetFunction.Max(WS.Range("C" & I - Incr & ":C" & I))
WSConv.Cells(MaxRowConv, "D") = WS.Application.WorksheetFunction.Min(WS.Range("D" & I - Incr & ":D" & I))
WSConv.Cells(MaxRowConv, "E") = WS.Cells(I, "E")
WSConv.Cells(MaxRowConv, "F") = WS.Application.WorksheetFunction.Sum(WS.Range("F" & I - Incr & ":F" & I))
MaxRowConv = MaxRowConv + 1
Incr = StandardIncr
I = I + Incr
Next I
'---> Enable Events
With Application
.EnableEvents = True
.ScreenUpdating = True
.DisplayAlerts = True
End With
MsgBox ("Conversion 1 to 15 Done")
End Sub
ITJockey sorry for inconvenience.
Gowflow
Data-Convert-V06.xlsm
ASKER
In this question I learned term "Dedication" from both of you. As question is closed and still immense efforts I had seen.
Thank You
Thank You
"dedication" maybe, but rather "consciousness" as we are here not to gain points, but to provide solutions and when solutions are not 'correct' it is our duty to correct as end user not always knowledgeable (I always assume that end user don't even know how to type, with all due respect to end users not to diminish one's knowledge but in the contrary to force one to do more) that is the extreme and feel an obligation to provide as accurate as possible solution in the limit of one knowledge.
Tks your appreciation, this is the FUEL that get us going !
gowflow
Tks your appreciation, this is the FUEL that get us going !
gowflow
Any news on your projects ? Let me know if you need help.
gowflow
gowflow
ASKER
By the end of this month I have to finish any how. Working out on flow of process. As and when it finish I will surely let you know.
Thanks
Thanks
No problem take care.
gowflow
gowflow
ASKER
You already have Steeve on it !!!
gowflow
gowflow
ASKER
oh.....Yes but I don't know he still on the question or not... but you are right I have to Waite ... it is very bad manners if some one working for you & .....
I had this thought only bcoz of I came to conclusion that it will get it through Code only.
I have respect for Sir The_Barman as he had solved many question of mine in past, I don't know he remembered or not.
Conclusion - Waite for Sir Steve to revert back.
Generally - I never asked other expert if some one working on it.
Thanks You
I had this thought only bcoz of I came to conclusion that it will get it through Code only.
I have respect for Sir The_Barman as he had solved many question of mine in past, I don't know he remembered or not.
Conclusion - Waite for Sir Steve to revert back.
Generally - I never asked other expert if some one working on it.
Thanks You
ASKER
May I ask new question?
ASKER
pls try
Open in new window
RegardsData-Convert-V03.xlsm