Solved

Tidying up worksheet to get rid of "junk" information

Posted on 2013-12-12
12
312 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 6
  • 6
12 Comments
 
LVL 50

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 50

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
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

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 50

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
 
LVL 50

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 50

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 50

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

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
need assistance with a VBscript 3 37
Need help with an Excel Formula 2 29
Help to break down spreadsheet 3 39
Help to find the duplicates 8 17
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

756 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