Needing Code to format Raw Excel Spreadsheet

Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

nuschool33

Thread Starter
Joined
Sep 28, 2006
Messages
37
All,

Ok, I feel like the Terminator...I'm Back!! I have yet another raw excel spreadsheet that I need some code to format so that I can import it into an existing Access table. Since the Access table is already existing, I would really just like to be able to run a macro and format this one before importing. You all have been a great help, and I have been learning, but this one I just can't crack...maybe because the raw format seems so scrambled to me.

I have posted the Unformatted and "Formatted" versions of the document. I would like a code to get from the unformatted to formatted version. The formatted version was done manually, but the unformatted version is so much longer it would take forever to do manually.

If you have any specific questions please feel free to reply and I will give anything needed to get this done.

Thanks to all in advance.
 

Attachments

Joined
Jul 1, 2005
Messages
8,546
I hope those aren't real names.

The worst bit is that "Sign-on" can appear more than once between one change of name & the next.

Select Sheet1, run Sub test, then check Sheet2.

HTH,
bomb

Sub test()

Application.ScreenUpdating = False

Sheets("Sheet1").Select: Range("A2").Select

Do Until ActiveCell = ""

If ActiveCell = "Sign-on" And InStr(ActiveCell.Offset(-1, 0), ",") <> 0 Then

Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1, -1) = ActiveCell.Offset(-1, 0)
ActiveCell.Offset(, 1).Resize(ActiveCell.Offset(, 2).End(xlDown).Row - ActiveCell.Row + 1, 4).Copy _
Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1, 0)

End If

ActiveCell.Offset(1, 0).Select

Loop

Application.ScreenUpdating = True

End Sub
 

Attachments

Joined
Jul 25, 2004
Messages
5,458
This data looks soo familiar... like I've seen it before...

Anyway, I was giving you hell Andy, your way I'm sure works perfectly fine, I just hate Selecting. I'll post my code in a moment. First, nuschool33, do you need any of the data at the bottom of the page?
 
Joined
Jul 1, 2005
Messages
8,546
Selecting was avoided where possible, e.g.:

ActiveCell.Offset(, 1).Resize(ActiveCell.Offset(, 2).End(xlDown).Row - ActiveCell.Row + 1, 4).Copy

;)
 
Joined
Jul 1, 2005
Messages
8,546
Actually, you're right -- For Each ... Next would be a option. But since the code takes 2 secs for the data provided anyway ... :)
 
Joined
Jul 25, 2004
Messages
5,458
Selecting shouldn't just be avoided where possible, it shouldn't even be used, let alone considered, if you do not need to. Your code is very fast indeed, but doesn't give you very much control over the end result. To keep it truly dynamic and viable data, you need to alter the data, preferably at run-time.

While my code is on average of 0.1 seconds slower than yours, the data is all handled and nicely put in it's own workbook while being dynamic to the data presentation. The object is probably what slows it down, but it's a nice way of getting uniques. I probably could have used AdvancedFilter to a unique range and populated the array with that, but I decided to take the easy way out. LOL! All in all the code sets are comparabale and boil down to preference.

So, here is my take...

Code:
Sub Format_SignOnEvents_Data()

    Dim wb As Workbook, ws As Worksheet, wsTarget As Worksheet, rngFilter As Range
    Dim dic As Object, dicItem As Variant, arrDic() As Variant
    Dim i As Long, LastRow As Long, NewRow As Long
    
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    Set ws = ActiveWorkbook.Sheets(1)
    Set wb = Workbooks.Add(xlWBATWorksheet)
    Set wsTarget = wb.Sheets(1)
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row - 1
    ws.Range(LastRow + 1 & ":" & LastRow + 3).Delete
    
    ws.Columns(1).Insert
    ws.Range("A4").Value = "FilterCol"
    ws.Range("A5").Formula = "=B5"
    ws.Range("A6:A" & LastRow).Formula = "=IF(ISNUMBER(FIND("", "",B6,1)),B6,A5)"
    ws.Range("A5:A" & LastRow).Value = ws.Range("A5:A" & LastRow).Value
    With wsTarget.Range("A1:E1")
        .Value = Array("Agent", "Idle Reason", "Date", "Time", "Duration")
        .HorizontalAlignment = xlCenter
        .Font.Underline = xlUnderlineStyleSingle
    End With
    arrDic = ws.Range("A5:A" & LastRow).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(arrDic) To UBound(arrDic)
        If Not dic.exists(arrDic(i, 1)) Then
            dic.Add arrDic(i, 1), arrDic(i, 1)
        End If
    Next i
    With wsTarget
        For Each dicItem In dic
            ws.Range("A4:F" & LastRow).AutoFilter 1, dicItem
            NewRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
            Set rngFilter = ws.Range("B5:F" & LastRow).SpecialCells(xlCellTypeVisible)
            If Not rngFilter Is Nothing Then
                rngFilter.Copy .Cells(NewRow, "A")
                .Range("B" & NewRow & ":E" & NewRow).Delete xlUp
                .Cells(ws.Rows.Count, "A").End(xlUp).Offset(-1, 0).Resize(2, 1).EntireRow.Delete
                .Range("A" & NewRow + 1 & ":A" & wsTarget.Cells(ws.Rows.Count, "A").End(xlUp).Row).ClearContents
            End If
            Set rngFilter = Nothing
        Next dicItem
        With .Range("E2:E" & .Cells(.Rows.Count, "E").End(xlUp).Row)
            .TextToColumns Destination:=wsTarget.Range("E2"), DataType:=xlDelimited, FieldInfo:=Array(1, 1)
        End With
        .Columns(5).Insert
        LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        With .Range("D2:D" & LastRow)
            .TextToColumns Destination:=.Range("E2"), DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(8, 1))
        End With
        .Range("G:G").Delete: .Range("G1:H1").Delete xlShiftUp
        .Range("I2:I" & LastRow).Formula = "=IF(H2=""AM"",G2,G2+0.5)"
        .Range("I2:I" & LastRow).Value = .Range("I2:I" & LastRow).Value
        .Range("I:I").NumberFormat = "h:mm:ss AM/PM"
        .Range("G:H").Delete
        .Range("G:G").Cut .Range("E:E")
        .Range("D:D").Delete
        .Range("D1").FillRight
        .Range("D1").Value = "Time"
    End With
    ws.Columns(1).Delete
    wsTarget.Cells.EntireColumn.AutoFit
    ws.AutoFilterMode = False
    
    Application.CutCopyMode = False
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
End Sub
 
Joined
Jul 1, 2005
Messages
8,546
firefytr said:
Selecting shouldn't just be avoided where possible, it shouldn't even be used, let alone considered, if you do not need to.
As you wish. :)

Sub test()

Sheets("Sheet1").Select

For Each Cell In Range("A2", Range("A" & Rows.Count).End(xlDown))

If Cell = "Sign-on" And InStr(Cell.Offset(-1, 0), ",") <> 0 Then

Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1, -1) = Cell.Offset(-1, 0)
Cell.Offset(, 1).Resize(Cell.Offset(, 2).End(xlDown).Row - Cell.Row + 1, 4).Copy _
Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1, 0)

End If

Next Cell

End Sub
 
Joined
Jul 25, 2004
Messages
5,458
And it is good, but it takes nearly twice as long as mine to run (which is still slightly longer than your original, to note). :)
 

nuschool33

Thread Starter
Joined
Sep 28, 2006
Messages
37
Ok, bomb and firefytr....sorry for the delayed response. Work nights, and couldn't get back to the PC in time yesterday. Anyway, both work just fine, not to worried about the time it takes to complete as long as it isn't a dramatic difference. In any event, I have another question along with this....

Is it possible to delete all entries of "Automatic/No Reason" and "Automatic Idle with Sign-on"? and then combine the duration times for the "Break" entries?

The previous request seemed fairly effortless for you two, so hopefully this isn't asking too much. Essentially, I would like to take the end results from firefytr's code, and make a couple more additions/changes to make the sheet look like this:

Additional Formatting???

Then after the extra data is deleted, combine the break entries for each person and add the duration cells together?

Is this possible?

***Firefytr*** - No I do not need any of the data at the bottom.

Thanks again in advance.

Nuschool33
 

nuschool33

Thread Starter
Joined
Sep 28, 2006
Messages
37
Ok, guys.......don't shoot me thru the web, but i found a better report for the end result that i really need. Hopefully, this doesn't take too much change. Scratch what was previously requested, and see if this one is any easier/harder.

I need this:

Idle Raw. xls

to look like this:

Idle Concept.xls

Thanks for everything, and let me know what else may make this easier for you guys. I will try to be online more today for any other questions.

Thanks Again,

Nuschool33
 

Attachments

Joined
Jul 25, 2004
Messages
5,458
I think you're starting to get a little too far past the point of benefit. Meaning that you could still import this stuff into Access and have it there to query as you want to, building what you need in a simple report. Why can you not do this? Are these in text files? If so, you can import those to Access as well.
 
Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

Users Who Are Viewing This Thread (Users: 0, Guests: 1)

As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 807,865 other people just like you!

Latest posts

Staff online

Top