Avatar of Member_2_5230414
Member_2_5230414
 asked on

Tidying up worksheet to get rid of "junk" information

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
Microsoft ExcelVisual Basic ClassicVB Script

Avatar of undefined
Last Comment
Member_2_5230414

8/22/2022 - Mon
Rgonzo1971

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
Member_2_5230414

ASKER
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???
Rgonzo1971

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
Experts Exchange is like having an extremely knowledgeable team sitting and waiting for your call. Couldn't do my job half as well as I do without it!
James Murphy
Member_2_5230414

ASKER
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.
Rgonzo1971

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
Member_2_5230414

ASKER
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
⚡ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
Rgonzo1971

Hi
Could you be more precise with example

Regards
Member_2_5230414

ASKER
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
Rgonzo1971

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
This is the best money I have ever spent. I cannot not tell you how many times these folks have saved my bacon. I learn so much from the contributors.
rwheeler23
Member_2_5230414

ASKER
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)
ASKER CERTIFIED SOLUTION
Rgonzo1971

THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
GET A PERSONALIZED SOLUTION
Ask your own question & get feedback from real experts
Find out why thousands trust the EE community with their toughest problems.
Member_2_5230414

ASKER
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