?
Solved

Copy and Loop Data

Posted on 2011-10-26
5
Medium Priority
?
207 Views
Last Modified: 2012-05-12
Hi Experts,

I would like to request Experts help create a macro to copy data from “Data” (column A: D) sheet to “Detail” sheet (Column B :E). However, the date info needs to copied at column A (Detail) and loop the date. I have manually copied the data at Detail sheet for Experts to get a better view. Hope Expert will help me create this feature.



Data-Date.xls
0
Comment
Question by:Cartillo
  • 2
  • 2
5 Comments
 
LVL 19

Assisted Solution

by:regmigrant
regmigrant earned 200 total points
ID: 37036506
you dont need a macro for this if you are willing to accept some limitations on the output format a pivto table will be i
Reg

Data-Date-1--pivot.xlsx
0
 
LVL 17

Accepted Solution

by:
andrewssd3 earned 1800 total points
ID: 37038263
The pivot table is a good solution, but does still suffer from the problem that the date is not repeated on every row, and some times for lookups etc, it's convenient to have that.  This code creates the Detail sheet as I think you want it, minus some of your formatting, which could easily be added.  Like any code of this sort it's dependent on the format of the input data, but this matches yours.  The main assumption is that all the detail rows for one day will be contiguous wiith no blank rows.  In the Detail sheet, I have copied the date as a 'proper' Excel date, with a number format to display it with the day in brackets after it. This should make filtering, etc easier.
Public Sub CopyData()

    Dim shtData As Excel.Worksheet
    Dim shtDetail As Excel.Worksheet
    Dim rngOut As Excel.Range
    Dim rngIn As Excel.Range
    Dim lngLastRow As Long
    Dim x As Long
    
    Dim dtCurrentDate As Date

    Dim aHeaders As Variant
    Const clngColToCopy As Long = 4

    aHeaders = Array("Date", "Time", "Status", "Title", "Total Duration")

    Set shtData = ActiveWorkbook.Worksheets("Data")
    Set shtDetail = ActiveWorkbook.Worksheets("Detail")

    shtDetail.UsedRange.Clear
    
    ' put the headers into the Detail sheet
    Set rngOut = shtDetail.Cells(1)
    rngOut.Resize(1, UBound(aHeaders) - LBound(aHeaders) + 1).Value = aHeaders

    ' point rngOut to the next row, and one column across to account for the date column
    Set rngOut = rngOut.Offset(1, 1)
    

    Set rngIn = shtData.UsedRange
    lngLastRow = rngIn.Rows(rngIn.Rows.Count).Row
    
    ' move to the start of the data
    Set rngIn = rngIn.Cells(1)
    Do While (rngIn.Value <> "Date/Time") And (rngIn.Row < lngLastRow)
        Set rngIn = rngIn.Offset(1, 0)
    Loop
    
    ' didn't find the expected header
    If (rngIn.Row >= lngLastRow) Then Exit Sub
    
    Do While (rngIn.Row <= lngLastRow)
        
        If Not IsEmpty(rngIn.Value) Then
            If InStr(1, rngIn.Value, "/") > 0 Then      ' a new day
                x = InStr(1, rngIn.Value, "(")
                If x > 0 Then
                    dtCurrentDate = CDate(Left$(rngIn.Value, x - 1))
                End If
            Else
                If IsNumeric(rngIn.Value) Then      ' a time row
                    ' get all the times - assumes there are no blank rows in a day
                    Set rngIn = shtData.Range(rngIn, rngIn.End(xlDown))
                    Set rngIn = rngIn.Resize(rngIn.Rows.Count, clngColToCopy)
                    
                    ' now copy them to the output area
                    Set rngOut = rngOut.Resize(rngIn.Rows.Count, rngIn.Columns.Count)
                    rngOut.Value = rngIn.Value
                    ' now put in the dates
                    rngOut.Offset(0, -1).Resize(rngOut.Rows.Count, 1).Value = dtCurrentDate
                    ' move rngOut on to the next row
                    Set rngOut = rngOut.Offset(rngOut.Rows.Count, 0).Resize(1, 1)
                    
                End If
            End If
        End If
        
        Set rngIn = rngIn.Offset(rngIn.Rows.Count, 0).Resize(1, 1)
    Loop
    
    ' apply some number formatting
    shtDetail.Columns(1).Cells.NumberFormat = "dd/mm/yyyy (ddd)"
    shtDetail.Columns(2).Cells.NumberFormat = "hh:mm"
    shtDetail.Columns(5).Cells.NumberFormat = "hh:mm"

End Sub

Open in new window

0
 
LVL 19

Expert Comment

by:regmigrant
ID: 37045550
@andrew - Kudos on the code, but doesnt the 'repeat all items' option sort out the repeating field on the pivot table? - or is that only available in later versions?

0
 
LVL 17

Expert Comment

by:andrewssd3
ID: 37047061
@regmigrant - yes you're right - I didn't know that option but I've found it on Excel 2010 - not sure if it was available in 2003 and before.

Having said that I've just noticed the pivot table is based on the Detail sheet - which is what @cartillo wants us to create - so you need to run the code to get the details sheet before you can generate the pivot.
0
 

Author Closing Comment

by:Cartillo
ID: 37057715
Hi,

Thanks a lot for the superb solution.
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

Question has a verified solution.

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

Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

862 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question