• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Macro

Hi Charles,

It looks like the sheet labelled "Raw" is the result of a PivotTable, based on it's layout. Any change you could get the original file and use the raw data there?

Beyond that, which values would be getting transferred? I'm guessing the 'length', and the percent value is a calculated field?
 
Is it okay if we re-arrange the data on the Raw sheet, or does it need to stay in that layout?
 
Hi:

I am off to a meeting now. I will look into it later on. It is difficult to achieve this without helper columns since your data is not in a user friendly manner.

Edit: What do you have in mind, what do you mean by another way ?

Thanks
 
Last edited:
Nebu may have a better idea, but this macro should work for now
Code: 
Sub BuildData()
Dim wsNew As Worksheet
Dim wsDest As Worksheet
Dim lastRow As Long
Dim lastCol As Long
Dim c As Range


'Where will data go?
Set wsDest = ThisWorkbook.Worksheets("Roster")

Application.ScreenUpdating = False
'Create a copy to work with
Worksheets("Raw").Copy after:=wsDest
Set wsNew = ActiveSheet
wsNew.Name = "HelperSheetDelete"

With wsNew
    'Fill in our data
    lastRow = .UsedRange.Rows.Count
    .Range("C2:C" & lastRow).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
   
    'Extract agent number
    .Range("D2:D" & lastRow).Formula = "=VALUE(TRIM(MID(SUBSTITUTE(C2,"" "",REPT("" "",999)),999,999)))"
   
    'Fill Dates
    For Each c In .Range("E:E").SpecialCells(xlCellTypeConstants)
        c.Offset(3).FormulaR1C1 = "=R[-3]C"
    Next c
   
    'Convert to values
    .Range("F2:F" & lastRow).Formula = "=DATEVALUE(MID(E10,FIND("" "",E10),999))"
   
    'Convert numbers stored as text
    .Range("M1").Value = 1
    .Range("M1").Copy
    .Range("L2:L" & lastRow).PasteSpecial xlPasteValues, xlPasteSpecialOperationMultiply
   
End With


With wsDest
    lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
    lastCol = .Cells(4, .Columns.Count).End(xlToLeft).Column
   
    'Fill in our data
    With .Range("E5", .Cells(lastRow, lastCol - 1))
        .Formula = "=SUMIFS(HelperSheetDelete!$L:$L,HelperSheetDelete!$D:$D,$B5,HelperSheetDelete!$F:$F,E$4)"
        .Copy
        .PasteSpecial xlPasteValues
        .NumberFormat = "h:mm"
    End With
   
    'Apply totals
    .Range(.Cells(5, lastCol), .Cells(lastRow, lastCol)).FormulaR1C1 = "=SUM(RC5:RC[-1])"
End With

'Delete helper sheet
Application.DisplayAlerts = False
wsNew.Delete
Application.DisplayAlerts = True

'Clean-up
Application.Goto wsDest.Range("E5")
Application.ScreenUpdating = True
   
End Sub
 
You must log in or register to reply here.
Back
Top