Deleting rows above and below data required

[David Wale]

Hello, a sub routine required please.

I want to look down column A and find the first instance of either, GK, DF, MF or

ST, (in this example ST is the the first instance at A32, it could have been GK, DF

or MF).

When the first instance has been found I want to delete all the rows above the

first instance, so ST at A32 would now be at A1.

Also, looking down column A, I want to find the last instance of either GK, DF, MF

or ST and delete all the rows after the last instance, (in this example GK is the last

instance at A58).

Thank you for any anticipated assistance

David Wale

	A
1	79,700 Likes
2	50,703 Followers
3	Your Basket £0.00
4	Your Tokens (0)
5	Log in
6
7	The Sun £1 MILLION Dream team - Fantasy Football 2011/2012
8	Proud Partner William Hill
9
10
11
12
13
14	Home
15	Predictor
16	Playing & Prizes
17	Stat Zone
18	Fixtures
19	Bet
20	FAQ
21
22	Player Stats
23	Player Stats
24	Select a player to view their profile
25	Click on the preferred column header to sort the stats
26	All
27	Goalkeepers
28	Defenders
29	Midfielders
30	Strikers
31	POS.
32	ST
33	ST
34	ST
35	ST
36	ST
37	MF
38	MF
39	MF
40	MF
41	MF
42	MF
43	MF
44	MF
45	MF
46	MF
47	MF
48	DF
49	DF
50	DF
51	DF
52	DF
53	DF
54	DF
55	DF
56	DF
57	GK
58	GK
448	Back to Stat Zone
449	Follow Us
450
451	Twitter
452	Facebook
453	www.thesun.co.uk
454
455	Latest Tweets
456	dreamteamfc
457	Star Man: Eden Hazard #lovemidweekpoints
458	dreamteamfc
459	Chelsea are slowly making up for abandoning us for Club World Cup #lovemidweekpoints
460	dreamteamfc
461	RT @daddy_spoon: @dreamteamfc how much is benteke? A must have - £2million. 75 points and counting #thebelgiansaretakingover
462	Top FAQ's
463	1. Most asked questions
464	2. How to play
465	3. Team Selection
466	4. Scoring
467	5. Transfers
468	6. Mini-leagues
469	7. Prizes
470	8. Packages
471	9. Payments
472	10. Lost details
473	11. How to play
474
475
476
477
478
479
480
481
482
483
484
485
486	WE ACCEPT THE FOLLOWING CARDS
487
488	PAYMENT POWERED BY
489
490	Contact us
491	T&C's
492	Privacy Policy
493	Payment Options
494	'The Sun', 'Sun' and 'Dream Team' are registered trademarks. All rights reserved. © News Group Newspapers Ltd, 2012/13.
495	News Promotions Limited is licensed and regulated by the Gambling Commission (Great Britain) License No. 000-001742-R-104050-001
496	By continuing to use the site, you agree to the use of cookies. You can change this and find out more by following this link.
497	Accept Cookies

<COLGROUP> <COL style="WIDTH: 30px; FONT-WEIGHT: bold"><COL style="WIDTH: 64px"> </COLGROUP><TBODY>
</TBODY>

Excel tables to the web >> Excel Jeanie HTML 4

 

[patel45]

Show us the final result

 

[Novelec]

Hi David,

Is your data in this column always continuous? That is, in the column listing the GK, DF, MF, ST values, are there ever blank cells part way through the values you want to keep? Or, are there values that are different to GK, DF, MF, ST...?

 

[MickG]

Perhaps this:-

[COLOR="Navy"]Sub[/COLOR] MG30Dec57
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] nRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
[COLOR="Navy"]If[/COLOR] IsError(Application.Match(Dn, Array("GK", "DF", "MF", "ST"), 0)) [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]Set[/COLOR] nRng = Dn
    [COLOR="Navy"]Else[/COLOR]
        [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dn)
  [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]If[/COLOR] Not nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] nRng.EntireRow.Delete
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Rick Rothstein]

Does this macro do what you want...

Sub ReduceData()
  Dim LastRow As Long, StartRow As Long, EndRow As Long
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  StartRow = Evaluate("MIN(IF(A1:A" & LastRow & "={""GK"",""DF"",""MF"",""ST""},ROW(A1:A" & LastRow & ")))")
  EndRow = Evaluate("MAX(IF(A1:A" & LastRow & "={""GK"",""DF"",""MF"",""ST""},ROW(A1:A" & LastRow & ")))")
  Rows(EndRow + 1 & ":" & Rows.Count).Delete
  If StartRow > 1 Then Rows("1:" & StartRow - 1).Delete
End Sub

 

[Novelec]

David,

Both Rick and Mick's solutions are far superior to mine, however I spent a bit of time writing mine (VBA amateur) so I will post anyway...



If you decide to use my snail-like code, simply change the range (highlighted in red) to suit your data.

Good luck with your football!

Sub Delete_Rows()


Dim Cell As Range
Dim Rows_To_Delete As Range
Dim Number_of_Rows As Integer


Set Range_To_Check = Range("[COLOR=#ff0000]A1:A200[/COLOR]")


    For Each Cell In Range_To_Check
        
        If Cell.Text <> "ST" And Cell.Text <> "MF" And Cell.Text <> "DF" And Cell.Text <> "GK" Then
                        
            If Rows_To_Delete Is Nothing Then
                Set Rows_To_Delete = Cell
            Else
                Set Rows_To_Delete = Union(Rows_To_Delete, Cell)
            End If
            
        End If
    
    Next
    
        Rows_To_Delete.Select
        Selection.EntireRow.Delete


End Sub

 

[David Wale]

Firstly I would like to wish you all a Happy New Year.

Secondly, I would like to thank MickG, Rick Rothstein and Novelec for the exact solution I required, and the interest shown by

Patel45.

Since joining Mr. Excel forum in the summer, I have asked for a number of solutions to problems, which have always been

answered.


So, thanks to all of you who have made my spreadsheet activities more rewarding by the week.


Yours cordially


David Wale