Go Premium for a chance to win a PS4. Enter to Win

x
Solved

# Data Convertion

Posted on 2014-02-23
Medium Priority
245 Views
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
0
Question by:Naresh Patel
• 8
• 5
• 4

LVL 53

Expert Comment

ID: 39881848
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
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
``````
EDIT Code Edited

Regards
0

LVL 8

Author Comment

ID: 39881869
Yes Perfect. Only One Thing After Sub End There Is Selection Left In Source Sheet - 1 Min Sheet.

Thanks
0

LVL 53

Expert Comment

ID: 39881872
Could you explain?
0

LVL 8

Author Comment

ID: 39881886
Now Two Things
Thanks
0

LVL 53

Expert Comment

ID: 39881894
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

LVL 8

Author Comment

ID: 39881899
may I have this modification which over past on data ?    Thanks
0

LVL 53

Accepted Solution

Rgonzo1971 earned 2000 total points
ID: 39881917
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
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
``````
Regards
0

LVL 8

Author Closing Comment

ID: 39881928
Thanks & Thanks For Quick Response
0

LVL 31

Expert Comment

ID: 39882305
@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

LVL 8

Author Comment

ID: 39882337
I am on my way back to home. Sure I'll look in to this.
Thanks eagle eyes.   ;-)
0

LVL 53

Expert Comment

ID: 39882347
Hi all

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

Regards
0

LVL 31

Expert Comment

ID: 39882351
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

LVL 8

Author Comment

ID: 39884918
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

LVL 31

Expert Comment

ID: 39885152
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.

gowflow
0

LVL 8

Author Comment

ID: 39885155
New Question Sir
0

LVL 31

Expert Comment

ID: 39885158
ok fine pls post a link in here
gowflow
0

LVL 8

Author Comment

ID: 39885181
Here it is Data Convertion.

Thanks
0

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Microsoft's Excel has many features that most people will never need nor take advantage of.  Conditional formatting is one feature that you may find a necessity once you start using it.
Cancel future meetings from user mailboxes in Office 365 using Remove-CalendarEvents
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaacâ€¦
Look below the covers at a subform control , and the form that is inside it. Explore properties and see how easy it is to aggregate, get statistics, and synchronize results for your data. A Microsoft Access subform is used to show relevant calculâ€¦
###### Suggested Courses
Course of the Month10 days, 18 hours left to enroll