Solved

Tidying up worksheet to get rid of "junk" information

Posted on 2013-12-12
12
292 Views
Last Modified: 2013-12-13
Hi Guys,

Attched is a work book.

Sheet1 shows a list of horse races with stats that i pull from the internet - at the moment i have to go through manualy to make my selctions but i would like to have this process automatic.

I would like it so when i copy and paste the data into sheet1 sheet to can read the data from sheet one and make it neat!!!

Basicly i need to strip out the 'junk' and put it together shown in tab2. I have also added an extra colum 'Race Num' this will need to have the race number in so race 1,2,3,4,5 ect.

The issue is each selection will be different depending on the number of horses in the race BUT it will always begin with the header titles for each race "No.      Form      Days      Horse      Age      Weight      Headgear      Jockey      Trainer      OR      FC Odds      HRB Total      CD Form
" and will and with a blank column then "Last Years Winner"      .

Hopefuly i have given enough information to hopefully get an answer to how this can be done.
J.P.B.S.xlsx
0
Comment
Question by:runnerjp2005
  • 6
  • 6
12 Comments
 
LVL 49

Expert Comment

by:Rgonzo1971
ID: 39713928
Hi,

pls try

Sub macro1()

Application.ScreenUpdating = False
    ActiveWorkbook.Worksheets("Info").Copy After:=Sheets(Sheets.Count)
    Set ResultSht = Sheets(Sheets.Count)
    ResultSht.Name = "Result"
    Range("1:4").EntireRow.Delete
    Range("N1") = "Number"
    Idx = 1
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    rwIdx = 2
    AreaIsOn = True
    Do While rwIdx <= lastRow
    If Cells(rwIdx, 1) = "No." Then
        AreaIsOn = True
        Cells(rwIdx, 1).EntireRow.Delete
        Idx = Idx + 1
        Range("N" & rwIdx).Value = Idx
        rwIdx = rwIdx + 1

    ElseIf AreaIsOn = True And Cells(rwIdx, 1) = "" Then
        AreaIsOn = False
        Cells(rwIdx, 1).EntireRow.Delete
        Debug.Print Cells(rwIdx, 1).End(xlDown).Row
    ElseIf AreaIsOn = False And (Cells(rwIdx + 1, 1) <> "" Or Cells(rwIdx + 2, 1) <> "" Or Cells(rwIdx + 3, 1) <> "") Then
        Cells(rwIdx, 1).EntireRow.Delete
        lastRow = Range("A" & Rows.Count).End(xlUp).Row
    Else
        Range("N" & rwIdx).Value = Idx
        rwIdx = rwIdx + 1
    End If
    Loop
ResultSht.Range("A1").Activate
Application.ScreenUpdating = True
End Sub

Open in new window

Regards
Copy-of-J.P.B.xlsm
0
 

Author Comment

by:runnerjp2005
ID: 39713942
Thats amazing! this is exactly what i wanted thanks!

Just one thing.... instead of creating a sheet named reults each time (ResultSht.Name = "Result"
) could it just replace the data in results with the new data???
0
 
LVL 49

Expert Comment

by:Rgonzo1971
ID: 39714024
Hi

If you prefer I do not recommend it because if the macro as a problem you won't recover your data with undo

Sub macro1()

Application.ScreenUpdating = False
    Sheets("Info").Activate
    Range("1:4").EntireRow.Delete
    Range("N1") = "Number"
    Idx = 1
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    rwIdx = 2
    AreaIsOn = True
    Do While rwIdx <= lastRow
    If Cells(rwIdx, 1) = "No." Then
        AreaIsOn = True
        Cells(rwIdx, 1).EntireRow.Delete
        Idx = Idx + 1
        Range("N" & rwIdx).Value = Idx
        rwIdx = rwIdx + 1

    ElseIf AreaIsOn = True And Cells(rwIdx, 1) = "" Then
        AreaIsOn = False
        Cells(rwIdx, 1).EntireRow.Delete
        Debug.Print Cells(rwIdx, 1).End(xlDown).Row
    ElseIf AreaIsOn = False And (Cells(rwIdx + 1, 1) <> "" Or Cells(rwIdx + 2, 1) <> "" Or Cells(rwIdx + 3, 1) <> "") Then
        Cells(rwIdx, 1).EntireRow.Delete
        lastRow = Range("A" & Rows.Count).End(xlUp).Row
    Else
        Range("N" & rwIdx).Value = Idx
        rwIdx = rwIdx + 1
    End If
    Loop
    Range("N1").End(xlDown).ClearContents
    Range("A1").Activate
Application.ScreenUpdating = True
End Sub

Open in new window


Regards
0
 

Author Comment

by:runnerjp2005
ID: 39714066
Sorry i ment it on a sep tab...so keep the results tab but you would need to delete it each time i ran the original code.
0
 
LVL 49

Expert Comment

by:Rgonzo1971
ID: 39714125
Hi

Here we are

Sub macro1()

Application.ScreenUpdating = False
    On Error Resume Next
    Set ResultSht = Sheets("Result")
    On Error GoTo 0
    If Not (IsEmpty(ResultSht)) Then
        Application.DisplayAlerts = False
        Sheets("Result").Delete
        Application.DisplayAlerts = True
    End If
    ActiveWorkbook.Worksheets("Info").Copy After:=Sheets(Sheets.Count)
    Set ResultSht = Sheets(Sheets.Count)
    ResultSht.Name = "Result"
    Range("1:4").EntireRow.Delete
    Range("N1") = "Number"
    Idx = 1
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    rwIdx = 2
    AreaIsOn = True
    Do While rwIdx <= lastRow
    If Cells(rwIdx, 1) = "No." Then
        AreaIsOn = True
        Cells(rwIdx, 1).EntireRow.Delete
        Idx = Idx + 1
        Range("N" & rwIdx).Value = Idx
        rwIdx = rwIdx + 1

    ElseIf AreaIsOn = True And Cells(rwIdx, 1) = "" Then
        AreaIsOn = False
        Cells(rwIdx, 1).EntireRow.Delete
    ElseIf AreaIsOn = False And (Cells(rwIdx + 1, 1) <> "" Or Cells(rwIdx + 2, 1) <> "" Or Cells(rwIdx + 3, 1) <> "") Then
        Cells(rwIdx, 1).EntireRow.Delete
        lastRow = Range("A" & Rows.Count).End(xlUp).Row
    Else
        Range("N" & rwIdx).Value = Idx
        rwIdx = rwIdx + 1
    End If
    Loop
    Range("N1").End(xlDown).ClearContents
    Range("A1").Activate
Application.ScreenUpdating = True
End Sub

Open in new window

Regards
0
 

Author Comment

by:runnerjp2005
ID: 39714209
Thats brilliant thanks!!!

Could I be cheeky and ask one more thing ... can i have anouther row added where it add's a + j / 2 (a2+j2/2)

So after number it will have total and it will contain a + j / 2
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 49

Expert Comment

by:Rgonzo1971
ID: 39714250
Hi
Could you be more precise with example

Regards
0
 

Author Comment

by:runnerjp2005
ID: 39714264
An example is attached....

I have also noticed if you look at line 619 in info it adds an extra colum "stall"
This messes up the result seaction (line 296) is there away that this can be removed when copying over to  results???
J.P.B.S.xlsx
0
 
LVL 49

Expert Comment

by:Rgonzo1971
ID: 39714290
Let's see

Sub macro1()

Application.ScreenUpdating = False
    On Error Resume Next
    Set ResultSht = Sheets("Result")
    On Error GoTo 0
    If Not (IsEmpty(ResultSht)) Then
        Application.DisplayAlerts = False
        Sheets("Result").Delete
        Application.DisplayAlerts = True
    End If
    ActiveWorkbook.Worksheets("Info").Copy After:=Sheets(Sheets.Count)
    Set ResultSht = Sheets(Sheets.Count)
    ResultSht.Name = "Result"
    Cells.NumberFormat = "General"
    Range("1:4").EntireRow.Delete
    Range("N1") = "Number"
    Range("O1") = "Total"
    Idx = 1
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    rwIdx = 2
    AreaIsOn = True
    Do While rwIdx <= lastRow
    If Cells(rwIdx, 1) = "No." Then
        AreaIsOn = True
        Cells(rwIdx, 1).EntireRow.Delete
        Idx = Idx + 1
        Range("N" & rwIdx).Value = Idx
        Range("O" & rwIdx).Formula = "=(J" & rwIdx & "+L" & rwIdx & ")/2"
        rwIdx = rwIdx + 1

    ElseIf AreaIsOn = True And Cells(rwIdx, 1) = "" Then
        AreaIsOn = False
        Cells(rwIdx, 1).EntireRow.Delete
    ElseIf AreaIsOn = False And (Cells(rwIdx + 1, 1) <> "" Or Cells(rwIdx + 2, 1) <> "" Or Cells(rwIdx + 3, 1) <> "") Then
        Cells(rwIdx, 1).EntireRow.Delete
        lastRow = Range("A" & Rows.Count).End(xlUp).Row
    Else
        Range("N" & rwIdx).Value = Idx
        Range("O" & rwIdx).Formula = "=(J" & rwIdx & "+L" & rwIdx & ")/2"
        rwIdx = rwIdx + 1
    End If
    Loop
    Range("N1").End(xlDown).ClearContents
    Range("A1").Activate
Application.ScreenUpdating = True
End Sub

Open in new window

Regards
0
 

Author Comment

by:runnerjp2005
ID: 39714415
Spot on but it still has an issue:

No.      Form      Days      Horse      Age      Weight      Headgear      Jockey      Trainer      Stall      OR      FC Odds      HRB Total      CD Form

Some of the stats have a column with stall in it... i need it to ingnor that when it copies over to the results page (if you look at row 619 you will see what i mean)
0
 
LVL 49

Accepted Solution

by:
Rgonzo1971 earned 500 total points
ID: 39715869
Here Stall Deleted

Sub macro1()

Application.ScreenUpdating = False
    On Error Resume Next
    Set ResultSht = Sheets("Result")
    On Error GoTo 0
    If Not (IsEmpty(ResultSht)) Then
        Application.DisplayAlerts = False
        Sheets("Result").Delete
        Application.DisplayAlerts = True
    End If
    ActiveWorkbook.Worksheets("Info").Copy After:=Sheets(Sheets.Count)
    Set ResultSht = Sheets(Sheets.Count)
    ResultSht.Name = "Result"
    Cells.NumberFormat = "General"
    Range("1:4").EntireRow.Delete
    Range("N1") = "Number"
    Range("O1") = "Total"
    Idx = 1
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    rwIdx = 2
    AreaIsOn = True
    Do While rwIdx <= lastRow
    If Cells(rwIdx, 1) = "No." Then
        AreaIsOn = True
        If Range("J" & rwIdx) = "Stall" Then
            Range(Range("J" & rwIdx), Range("J" & rwIdx).End(xlDown)).Delete Shift:=xlToLeft
        End If
        Cells(rwIdx, 1).EntireRow.Delete
        Idx = Idx + 1
        Range("N" & rwIdx).Value = Idx
        rwIdx = rwIdx + 1

    ElseIf AreaIsOn = True And Cells(rwIdx, 1) = "" Then
        AreaIsOn = False
        Cells(rwIdx, 1).EntireRow.Delete
    ElseIf AreaIsOn = False And (Cells(rwIdx + 1, 1) <> "" Or Cells(rwIdx + 2, 1) <> "" Or Cells(rwIdx + 3, 1) <> "") Then
        Cells(rwIdx, 1).EntireRow.Delete
        lastRow = Range("A" & Rows.Count).End(xlUp).Row
    Else
        Range("N" & rwIdx).Value = Idx
        rwIdx = rwIdx + 1
    End If
    Loop
    Range(Range("O2"), Range("O" & Range("A1").End(xlDown).Row)).FormulaR1C1 = "=(RC[-5]+RC[-3])/2"
    Range("N1").End(xlDown).ClearContents
    Range("A1").Activate
Application.ScreenUpdating = True
End Sub

Open in new window

Regards
0
 

Author Closing Comment

by:runnerjp2005
ID: 39716094
Amazing!!!

If i could give you more i would - just as i imagined ... i can easy work with the tidied up sheet!!!

Thanks so much
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

861 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

25 Experts available now in Live!

Get 1:1 Help Now