Help!!!

[JesseNich]

So what I thought would be an easy little macro, actually not even that, just tweaking an existing macro, has snow-balled into a ginormous out of control "Macro" that is consuming my life.

The gist of what I am try to accomplish is this. Take data from a swiper, extract the pieces I want (this part is done) then compare the time each person 1st swiped, and the time they swiped again, ignoring duplicate swipes that occur within 7 or 10 minutes or something. (this part is also done) Then calculate the elapsed time and round to the nearest quarter hour, which I have also accomplished. (mind you it may not have been accomplished the most efficient way)

This is where it gets hairy... I now need to take the computed elapsed time (the values from the cells not the equation) and create a new column with the date from the swipe data in row 1 in the main spreadsheet which has all the hours from all the days,(which is in a different workbook) and then paste the values in the correct rows depending on the id number from the swipes that is located in row A.


(I eventually would also like to enable the program to recognize different dates and move all the data from each individual date to a separate sheet and run all the same functions on every sheet.)

Here's what I have so far.... Anyone have any ideas where I can go next besides off a bridge.... (Oh and did I mention that last week when I started this I had never worked with a macro and had never even seen a line of visual basic code and the only code I had ever worked with was some BASIC html about 5 years ago) so yea it's been a learning process, and I feel like i've come a long way and am doing ok.

Sub get2PsFromCardSwipe()
'
' get2PsFromCardSwipe Macro
'
' Keyboard Shortcut: Ctrl+w
'
' If anyone ever looks at this code I am sorry, it is definitely full of alot of garbage code.
' I was basically teaching myself Visual Basic as I wrote this so there were a bunch of options tried and I didn't always
' remove all the pieces that weren't needed when I decided to go another route. The basic purpose of this MACRO is to allow
' students to swipe in and out of a study session / any event and then automatically calculate the amount of time they were
' actually there, rounded to the nearest 0:15 minutes.  It also ended up gaining more and more functionality as I went along
' and I realized oh man well this is going to need to be accounted for and what about this... so yea, it's a mess, and a
' work in progress.  But consider this, on November 17, 2009, Version 0.5


    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Log"
    Sheets(1).Select
    Rows("1").Insert
    Dim RangeofRows As Range
    Dim NumofRows As Long
    NumofRows = Range("B2").End(xlDown).Row
    Columns("C:C").Select
    Application.CutCopyMode = False
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=MID(RC[-1],8,10)"
    Range("C2").Select
    Selection.AutoFill Destination:=Range("C2:C5000"), Type:=xlFillDefault
    Range("C2").End(xlDown).Select
    
    ActiveWindow.ScrollRow = 1
    
    Columns("C:C").Select
    Selection.Copy
    Columns("A:A").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("B:C").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("A" & NumofRows + 1, "A5000").Select
    Selection.Delete
      
    
    Dim iCell As Range
    
    Dim SubCount As Long
    Dim TopDown As Long
    Dim BottomUp As Long
    Dim BottomUpLoop As Long
    Dim TopDownLoop As Long
    NumofRows = Range("A2").End(xlDown).Row
    Set RangeofRows = Range("A2", "A" & NumofRows)
    Set iCell = Range("B2").End(xlDown)
    BottomUp = NumofRows
    TopDown = 2
    
' This is where I need to add code to allow for the swiping of multiple days on the same swiper.
' Possibly check the dates in column B (I think they are all in Column B at this point) and then for each new date
' that you encounter create a new sheet and copy and paste all the rows that have that date to the new sheet???  Then you
' have to find a way to make sure that the code below is run on every sheet.
    

    
    
    
    
    
    
    
    
    For TopDownLoop = 2 To Range("A2").End(xlDown).Row Step 1
    
BottomUp = NumofRows
    For BottomUpLoop = NumofRows To 1 Step -1
        If Cells(TopDown, "A").Value = Cells(BottomUp, "A").Value Then
            If Cells(BottomUp, "B").Value - Cells(TopDown, "B").Value < 0.006 Then
                If BottomUp = TopDown Then
                Cells("1", "A").Select
                Else
                Rows(BottomUp).ClearContents
                End If
            ElseIf TopDown = BottomUp Then
            
            Cells("1", "A").Select
            
            Else
                Cells(BottomUp, "B").Select
                Selection.Copy
                Cells(TopDown, "C").Select
                ActiveSheet.Paste
                Application.CutCopyMode = False
                Rows(BottomUp).ClearContents
            End If
           
        End If
        BottomUp = BottomUp - 1
        Next BottomUpLoop
        TopDown = TopDown + 1
    Next TopDownLoop
    
    Cells("1", "A").Select
      Range("D2").Formula = "=SUM(C2-B2)*24"
     Range("D2").AutoFill Destination:=Range("D2:D" & NumofRows)
     
     BottomUpLoop = NumofRows
     Dim LessThan As Long
     LessThan = NumofRows
     For BottomUpLoop = NumofRows To 1 Step -1
            If Cells(LessThan, "D").Value < 0.0001 Then
            If Cells(LessThan, "D") = "" Then
            Rows(LessThan).Delete
            Else
            Rows(LessThan).Delete
        End If
        End If
        LessThan = LessThan - 1
     Next BottomUpLoop
     
     NumofRows = Range("B1").End(xlDown).Row
     
     Cells("1", "A").Select
      Range("D1").Formula = "=ROUND((C1-B1)*24/"".25"",0)*"".25"""
     Range("D1").AutoFill Destination:=Range("D1:D" & NumofRows)
     
     
     
    
    ActiveWorkbook.SaveAs Filename:="Card Swipe Time Log 2Ps Uploaded " & _
    Format(Now(), "mm_dd_yyyy hh mm AMPM") & ".xlsx", FileFormat:= _
        xlNormal, CreateBackup:=False
        
' This is where I need to enter code to open the main workbook and add a column to the left of
' the last used column, and then compare values from each cell in column A in the Workbook we just saved
' (CardSwipe) to the values in Column A in the workbook we just opened and when a match is found to copy the
' value (not the formula but the result of the formula) from column D in that row to the corresponding row
' in the newly created column in the main workbook.  How to do this, I have no idea, especially if I have
' multiple sheets in CardSwipe.  Ha I thought this would be a simple little macro and it's turning into a
' major project.

Workbooks.Open Filename:="H:\My Documents\Fall 09 - 10 Study Session Hours - Test.xlsx"
     
        
        
        
        
End Sub

Sorry it's such a mess... :\