1. Computer problem? Tech Support Guy is completely free -- paid for by advertisers and donations. Click here to join today! If you're new to Tech Support Guy, we highly recommend that you visit our Guide for New Members.

Needing Code to format Raw Excel Spreadsheet

Discussion in 'Business Applications' started by nuschool33, Jan 30, 2007.

Thread Status:
Not open for further replies.
Advertisement
  1. nuschool33

    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.
     

    Attached Files:

  2. bomb #21

    bomb #21

    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
     

    Attached Files:

  3. Zack Barresse

    Zack Barresse

    Joined:
    Jul 25, 2004
    Messages:
    5,452
    .. oh Andy... you're killin' me! LOL!
     
  4. bomb #21

    bomb #21

    Joined:
    Jul 1, 2005
    Messages:
    8,546
    Glad to hear it. :) & the workable alternative is ... ?
     
  5. Zack Barresse

    Zack Barresse

    Joined:
    Jul 25, 2004
    Messages:
    5,452
    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?
     
  6. bomb #21

    bomb #21

    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

    ;)
     
  7. bomb #21

    bomb #21

    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 ... :)
     
  8. Zack Barresse

    Zack Barresse

    Joined:
    Jul 25, 2004
    Messages:
    5,452
    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
     
  9. bomb #21

    bomb #21

    Joined:
    Jul 1, 2005
    Messages:
    8,546
    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
     
  10. Zack Barresse

    Zack Barresse

    Joined:
    Jul 25, 2004
    Messages:
    5,452
    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). :)
     
  11. bomb #21

    bomb #21

    Joined:
    Jul 1, 2005
    Messages:
    8,546
    Seriously? Cripes, I thought my PC was clapped out. :D
     
  12. Zack Barresse

    Zack Barresse

    Joined:
    Jul 25, 2004
    Messages:
    5,452
  13. nuschool33

    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
     
  14. 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
     

    Attached Files:

  15. Zack Barresse

    Zack Barresse

    Joined:
    Jul 25, 2004
    Messages:
    5,452
    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.
     
  16. Sponsor

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 733,556 other people just like you!

Loading...
Thread Status:
Not open for further replies.

Short URL to this thread: https://techguy.org/539548

  1. This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
    By continuing to use this site, you are consenting to our use of cookies.
    Dismiss Notice