Data Convertion

Hi Experts,

I have one WB which convert 1 min data to 15 Min data on Button click.
I need modification in Code which include only data between 9:15 AM To 15:30 PM while converting 1 min to 15 min.

Thanks
Data-Convert-V02.xlsm
LVL 8
Naresh PatelTraderAsked:
Who is Participating?
 
Rgonzo1971Connect With a Mentor Commented:
To replace the data

use

Option Explicit

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
Application.ScreenUpdating = False
Set WS = ActiveSheet
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
Application.ScreenUpdating = False
StandardIncr = 14
Incr = StandardIncr
'---> Start Process
For I = 2 + Incr To MaxRow Step Incr + 1
    If I <> 2 + StandardIncr Then
        '---> Check to see if Current set of dates falls all within the same date
        If (TimeValue(WS.Cells(I - Incr, "A")) > TimeValue("15:30:00") And _
            DateValue(WS.Cells(I - Incr, "A")) <> DateValue(WS.Cells(I, "A"))) Then
            I = I + 1
        ElseIf DateValue(WS.Cells(I - Incr, "A")) <> DateValue(WS.Cells(I, "A")) Then
            
            J = I - Incr
            Do While TimeValue(WS.Cells(J, "A")) <= TimeValue("15:30:00")
                J = J + 1
            Loop

            Incr = J - 1 - (I - Incr)
            I = I - StandardIncr
        Else
            Incr = StandardIncr
        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
    
Next I
Application.ScreenUpdating = True
End Sub

Open in new window

Regards
0
 
Rgonzo1971Commented:
Hi,

pls try

Option Explicit

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

Set WS = ActiveSheet
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
Else
    MaxRowConv = WSConv.UsedRange.Rows.Count + 1
End If
On Error GoTo 0

StandardIncr = 14
Incr = StandardIncr
'---> Start Process
For I = 2 + Incr To MaxRow Step Incr + 1
    If I <> 2 + StandardIncr Then
        '---> Check to see if Current set of dates falls all within the same date
        If (TimeValue(WS.Cells(I - Incr, "A")) > TimeValue("15:30:00") And _
            DateValue(WS.Cells(I - Incr, "A")) <> DateValue(WS.Cells(I, "A"))) Then
            I = I + 1
        ElseIf DateValue(WS.Cells(I - Incr, "A")) <> DateValue(WS.Cells(I, "A")) Then
            
            J = I - Incr
            Do While TimeValue(WS.Cells(J, "A")) <= TimeValue("15:30:00")
                J = J + 1
            Loop

            Incr = J - 1 - (I - Incr)
            I = I - StandardIncr
        Else
            Incr = StandardIncr
        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
    
Next I
End Sub

Open in new window

EDIT Code Edited

Regards
0
 
Naresh PatelTraderAuthor Commented:
Yes Perfect. Only One Thing After Sub End There Is Selection Left In Source Sheet - 1 Min Sheet.


Thanks
0
The 14th Annual Expert Award Winners

The results are in! Meet the top members of our 2017 Expert Awards. Congratulations to all who qualified!

 
Rgonzo1971Commented:
Could you explain?
0
 
Naresh PatelTraderAuthor Commented:
Now Two ThingsBy Selection Mean @ EndIf i delete some rows in sheet 15 min and again click on button - No result - have to overpast on actual data and fill deleted data.
Thanks
0
 
Rgonzo1971Commented:
HI

First Problem solved

the code is designed to add at the end of list the data in 1 min not to replace it

Regards
0
 
Naresh PatelTraderAuthor Commented:
may I have this modification which over past on data ?    Thanks
0
 
Naresh PatelTraderAuthor Commented:
Thanks & Thanks For Quick Response
0
 
gowflowCommented:
@itjockey

I think the proposed solution does not fit exactly your need !!! with all due respect although it fit the sample of data you provided that have time AFTER 15:30, it does not cater for data that is BEFORE 9:15

I have put Rgonzo1971 sub in the attached workbook and labeled it Convert_1to15_Rgonzo1971

Run it on the sample data that I added 4 lines in the beginning that covers 911 till 914 and you will see the results.

@Rgonzo1971 pls do not take these comments as addressed to you in any way.

Regards
gowflow
Data-Convert-V03.xlsm
0
 
Naresh PatelTraderAuthor Commented:
I am on my way back to home. Sure I'll look in to this.
Thanks eagle eyes.   ;-)
0
 
Rgonzo1971Commented:
Hi all

I thought it wasn't relevant since I supposed the data pulled would not have any data before 9:15

Regards
0
 
gowflowCommented:
Well a macro is a macro and limitations are limitation. I know about it coz I worked on the intial macro and when it came that we needed to eliminate data outside the 9:15  15:30 I said that a different logic should be considered.

Anyway no big deal
gowflow
0
 
Naresh PatelTraderAuthor Commented:
Yes Sir gowflow,

I had seen it include before 9:15 data too and I don't want that data in 15 min conversation.
so what you suggest ...I would like to post new question regarding this .......may I?


Thanks
0
 
gowflowCommented:
I think this question is closed and feel if you want a 'correct' answer as the one posted may apply to your data posted however it does not apply to 'any data' that could have al lot of items before 9:15 and after 15:30 scattered. As I mentioned in my previous post a different approached is to be considered.

It is up to you, you know your business better, if you feel that these situations may never happen then this macro could do the job, if not then you may post a new question to make sure ONLY data in the desired frame is taken into consideration.

Let me know your decision.
gowflow
0
 
Naresh PatelTraderAuthor Commented:
New Question Sir
0
 
gowflowCommented:
ok fine pls post a link in here
gowflow
0
 
Naresh PatelTraderAuthor Commented:
Here it is Data Convertion.


Thanks
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.