Calling a1ehouse

[Lennon]

Hey man ... hoping you can help me with Excel again ... (anyone else can too) Ok. This is what I want to do. http://en.allexperts.com/q/Excel-1059/EXCEL-VBA-FIND-COPY-1.htm I tryed to modify the formula given in the answer for myself but when I run the macro the result I get is "0 Finished rows copied" Here's my formula ... Sub CopyFinished() 'Copy cells of cols A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK from rows containing "Finished" in 'col C of the active worksheet (source sheet) to cola 'A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK of Results (destination sheet) Dim DestSheet As Worksheet Set DestSheet = Worksheets("Results") Dim aRow As Long 'row index on source worksheet Dim cRow As Long 'row index on destination worksheet Dim aCount As Long sCount = 0 cRow = 1

For sRow = 3 To Range("C65536").End(xlUp).Row
     'use pattern matching to find "Finished" anywhere in cell
     If Cells(sRow, "C") Like "*Finished*" Then
        sCount = sCount + 1
        cRow = cRow + 1
        'copy cols A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK
        Cells(sRow, "A").Copy Destination:=DestSheet.Cells(cRow, "A")
        Cells(sRow, "B").Copy Destination:=DestSheet.Cells(cRow, "B")
        Cells(sRow, "C").Copy Destination:=DestSheet.Cells(cRow, "C")
        Cells(sRow, "D").Copy Destination:=DestSheet.Cells(cRow, "D")
        Cells(sRow, "E").Copy Destination:=DestSheet.Cells(cRow, "E")
        Cells(sRow, "F").Copy Destination:=DestSheet.Cells(cRow, "F")
        Cells(sRow, "G").Copy Destination:=DestSheet.Cells(cRow, "G")
        Cells(sRow, "H").Copy Destination:=DestSheet.Cells(cRow, "H")
        Cells(sRow, "I").Copy Destination:=DestSheet.Cells(cRow, "I")
        Cells(sRow, "J").Copy Destination:=DestSheet.Cells(cRow, "J")
        Cells(sRow, "K").Copy Destination:=DestSheet.Cells(cRow, "K")
        Cells(sRow, "L").Copy Destination:=DestSheet.Cells(cRow, "L")
        Cells(sRow, "M").Copy Destination:=DestSheet.Cells(cRow, "M")
        Cells(sRow, "N").Copy Destination:=DestSheet.Cells(cRow, "N")
        Cells(sRow, "O").Copy Destination:=DestSheet.Cells(cRow, "O")
        Cells(sRow, "P").Copy Destination:=DestSheet.Cells(cRow, "P")
        Cells(sRow, "Q").Copy Destination:=DestSheet.Cells(cRow, "Q")
        Cells(sRow, "R").Copy Destination:=DestSheet.Cells(cRow, "R")
        Cells(sRow, "S").Copy Destination:=DestSheet.Cells(cRow, "S")
        Cells(sRow, "T").Copy Destination:=DestSheet.Cells(cRow, "T")
        Cells(sRow, "U").Copy Destination:=DestSheet.Cells(cRow, "U")
        Cells(sRow, "V").Copy Destination:=DestSheet.Cells(cRow, "V")
        Cells(sRow, "W").Copy Destination:=DestSheet.Cells(cRow, "W")
        Cells(sRow, "X").Copy Destination:=DestSheet.Cells(cRow, "X")
        Cells(sRow, "Y").Copy Destination:=DestSheet.Cells(cRow, "Y")
        Cells(sRow, "Z").Copy Destination:=DestSheet.Cells(cRow, "Z")
        Cells(sRow, "AA").Copy Destination:=DestSheet.Cells(cRow, "AA")
        Cells(sRow, "AB").Copy Destination:=DestSheet.Cells(cRow, "AB")
        Cells(sRow, "AC").Copy Destination:=DestSheet.Cells(cRow, "AC")
        Cells(sRow, "AD").Copy Destination:=DestSheet.Cells(cRow, "AD")
        Cells(sRow, "AE").Copy Destination:=DestSheet.Cells(cRow, "AE")
        Cells(sRow, "AF").Copy Destination:=DestSheet.Cells(cRow, "AF")
        Cells(sRow, "AG").Copy Destination:=DestSheet.Cells(cRow, "AG")
        Cells(sRow, "AH").Copy Destination:=DestSheet.Cells(cRow, "AH")
        Cells(sRow, "AI").Copy Destination:=DestSheet.Cells(cRow, "AI")
        Cells(sRow, "AJ").Copy Destination:=DestSheet.Cells(cRow, "AJ")
        Cells(sRow, "AK").Copy Destination:=DestSheet.Cells(cRow, "AK")
     End If
  Next sRow
  
  MsgBox sCount & " Finished rows copied", vbInformation, "Transfer Done"

End Sub

Also .. if it's possible, it would be great if you could make it cut instead of copy ... and also would it be possible for the macro to check for new cells with the word "Finished" automatically once a day and cut/paste those rows into the "Results" worksheet?

[Lennon]

Re: Calling a1ehouse Woops ... this was supposed to be posted in the tools and general betting forum .. mods can you move it there please?

[a1ehouse]

Re: Calling a1ehouse Untested, so let me know if there's a problem! :tongue2

Option Explicit

'Copy the whole row instead:
Sub CopyFinished()
    Dim rng As Range
    
    For Each rng In Range(Sheets("Sheet1").Range("C1"), Sheets("Sheet1").Range("C65536").End(xlUp))
        If InStr(rng.Text, "Finished") Then
            rng.EntireRow.Cut Sheets("Results").Range("A65536").End(xlUp).Offset(1, 0)
        End If
    Next rng
End Sub

'Then this deletes the empty rows:
Sub DeleteEmptyRows()
    Dim lastRow As Long, r As Long
    lastRow = Sheets("Sheet1").UsedRange.Rows.Count
    For r = lastRow To 1 Step -1
        If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
    Next r
End Sub

'So to run them every day we bung them together in a single macro:
Sub MoveAndPurge()
    Call CopyFinished
    Call DeleteEmptyRows
End Sub

'Bung this in the Workbook_Open:
Private Sub Workbook_Open()
    Application.OnTime TimeValue("18:00:00"), "MoveAndPurge"
End Sub

[Lennon]

Re: Calling a1ehouse Ok ... it looks like it's working pretty good ... couple of things Is it possible to cut instead of copy? Right now it's copying ... Is 18:00:00 the time of day that it will move the cells? Can I change this to any time I want? Also .. I was supposed to paste both codes in the same macro, right?

[a1ehouse]

Re: Calling a1ehouse

I ran it and nothing happpend ... I pasted the 2nd code in the same module as the first code .. was I supposed to make two seperate macros or something?

You should be able to run the code manually by running the MoveAndPurge macro. Make sure you change "Sheet1" to the name of where your pulling the info from. In VBA editor, on the left in the Excel Objects, double click ThisWorkbook. In the dropdown list (General) select WorkBook, 2nd code should go in there.

[Lennon]

Re: Calling a1ehouse Hey I see you're online now ... do you have msn or AOL so we can talk there?

[Lennon]

Re: Calling a1ehouse Changed the Copy to Cut in the formula and got it working perfect ... slowly learning Thanks again! edit: Just making sure ... after 24hrs when the macro looks for "Finished" games again it will cut/paste the row in the next open A cell ... right? I don't want it overwriting any data ...

[a1ehouse]

Re: Calling a1ehouse Don't use MSN/AOL sorry. It won't overwrite. If it's your sheet is open all the time, you can make it even easier and use the WorkSheet_Change object (from the Excel Objects again) This will fire everytime a cell is changed, no need to run it everyday as it will be immediate as soon as "Finished" appears in column C:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Left(Target.AddressLocal(ColumnAbsolute:=False), 1) = "C" Then
        If InStr(Target.Text, "Finished") Then
            Rows(Target.Row).Copy Sheets("Results").Range("A65536").End(xlUp).Offset(1, 0)
            Rows(Target.Row).Delete shift:=xlUp
        End If
    End If
End Sub

[Lennon]

Re: Calling a1ehouse Do I type that code under this code?

'Bung this in the Workbook_Open:
Private Sub Workbook_Open()
    Application.OnTime TimeValue("18:00:00"), "MoveAndPurge"
End Sub

I did that and typed "Finished" in cell C and it didn't move anywhere ...

[a1ehouse]

Re: Calling a1ehouse Goto the Excel Objects again, double click on your main worksheet you want to copy from (e.g. Sheet1), select WorkSheet from the (General) drop down box then Change from the other one.

[Lennon]

Re: Calling a1ehouse Now I'm getting .. Compile error: Ambigunous name detected: Worksheet_Change I think I deleted that code from all the other sheets I tried it in ... :S

[Lennon]

Re: Calling a1ehouse BTW, I also have this code above the one you just gave me .. should I delete it? I'll try that now ...

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Row = 1 Then
      If Target.Column < 1 Then
         If Target.Value = "pass" Then
           Cells(75, Target.Column).Value = Now
         End If
      End If
   End If
End Sub

Ok that worked :D Really appreciate your help in all of this ... I'll just bump this thread if I need anything else ... lol ... but I'll try to figure it out things by myself Can you recommend a good book/site to learn Excel/Visual Basic?

[a1ehouse]

Re: Calling a1ehouse No worries - it what a forum is about! Good for you to try and work it out though. I started by picking up bits and bobs too, so takes years of learning and putting into practice, but a powerful thing to have at your disposal. The web has a raft of info out there - google Mr. Excel or J Walk.

[Lennon]

Re: Calling a1ehouse .

[Lennon]

Re: Calling a1ehouse Also having trouble with Stefan's code here ... http://www.punterslounge.com/forum/f23/live-scores-fixture-list-excel-82791/index2.html#post1383591

[Lennon]

Re: Calling a1ehouse Bump ... I wish there was a PM feature here :(

[Smokin Joe]

Re: Calling a1ehouse

Bump ... I wish there was a PM feature here :(

There is, once you have 50 posts (I think)

[Lennon]

Re: Calling a1ehouse Awesome ... 4 more posts!