Macro to select rows in between keywords and the to cut and paste into a new sheet

[asolanki]

Hi Guys

I was wondering if anyone can help me do the following :

I have a data dump of data in Column A
This Column has data relevant to "Counties" - there are over 47 Counties in the list

What i want to do is have a macro that parses Column A - looks for the KeyWord "COUNTY" and then select the rows below this until it finds the next county keyword
These selected Rows, i would then like to be CUT and PASTED into a New Sheet - named according to the name of the County the data is for

EG - Data in Column A could be

Middlesex COUNTY
x
y
z
.
.1000 rows later
Lancashire COUNTY
x
y
z
.
.300 rows later
Surrey COUNTY
x
y
z
.
.500 rows later

So in this case the macro would create 3 sheets - - Middlesex, Lancashire and Surrey - - and in each sheet would be the data the macro selected

Middlesex would have 1000 records
Lanchashire would have 300 Records
Surrey would have 300


Hoping this makes sense and is doable
Thanks for your help and advice on achiving this - my back up is to do this manually which may take a while
Thanks again for any help you can give

Ash

 

[BiocideJ]

This should do what you are wanting.
Since this code will essentially delete your initial tab, I strongly recommend backing up the workbook prior to running the macro.

NOTE: You didn't mention anything about headers so this code does not copy any header information (presumably from row 1), however, the code does Paste the Cut data starting at row 2 of the new sheet. see comments in code.

Sub SplitByCounty()
Dim SrcSheet As Worksheet, NewSheet As Worksheet
Dim SrcRange As Range, startCell As Range
    'macro must be run with the data sheet as the currently active sheet
    Set SrcSheet = ActiveSheet
    Set SrcRange = SrcSheet.Columns(1)
    Set startCell = SrcRange.Find(What:="County", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, MatchCase:=False)
        
    Do Until startCell Is Nothing
        
        Set NewSheet = Sheets.Add(After:=SrcSheet)
        NewSheet.Name = startCell.Value
        SrcSheet.Range(startCell.Row & ":" & SrcSheet.Range("A" & SrcSheet.Rows.Count).End(xlUp).Row).EntireRow.Cut _
            NewSheet.Range("A2")    'adjust this range as where you want the data cut to (if not starting in A2)
        Set startCell = SrcRange.FindNext
        
    Loop
End Sub

 

[asolanki]

Hi BiocideJ
Thanks so much for helping me with this

Your assumption is correct Data starts at A2 to the last row

I tested the code as it is and i get the following

It seems to create only 2 sheets ( i have 47 counties in the list)
it grabs the LAST county in the column of data and correctly selects the data for that county - this works great
The second sheet it grabs the FIRST occurance( top of data) and then dumps the rest of the data in this which still includes the data for the remaining 46 counties

So it seems to do it for one section then stops

any ideas on how to modify the code for it to split all 47 counties

Thanks again for any help you can give
Ash

 

[BiocideJ]

Stupid mistake...
Change the last line from
SrcRange.FindNext
to
SrcRange.FindPrevious.

 

[asolanki]

Thanks So Much this works a treat - you are a star!!

I have another post that relates to this if you can work some magic on that
I cant figure out the logic on how i would split the data into the groups to parse the data
Thinking out loud - maybe if i was to look for the ":" in the words Tel:, Mobile:, Website:...then if the next row doesn't contain this ":" it could be the way to split the records, this is the only commonality i can see

If you have time - What do you think - would love your help if know how to do it
http://www.mrexcel.com/forum/excel-...sts-rows-adding-blank-row-seperate-group.html

 

[oitbc]

I need some help to modify this please. It's a great bit of code, but I can't figure out how to tweak it to what I want.

I have a dataset - it's basically a configuration document and what I would like to do is as follows

1) Run through the config, which is all in Col A, look for a keyword and extract the subset of data under the keyword out to the relevant sheet already created dependent on how many rows there are in the dataset.
2) The sheets are 1,2,3,4,5+ and relate to how may rows are in the definition
3) Make sure it strips out any row that starts with description from the count, but include it in the transfer to the new location

I've uploaded a screenshot - hopefully making it clear what I am looking to achieve and the original code from above

Sub SplitConfigFile()
Dim SrcSheet As Worksheet, NewSheet As Worksheet
Dim SrcRange As Range, startCell As Range

'Create new sheets to be used
        Set NewSheet1 = Sheets.Add(After:=SrcSheet)
        NewSheet1.Name = "1 line defs"
        Set NewSheet2 = Sheets.Add(After:=SrcSheet)
        NewSheet2.Name = "2 line defs"
        Set NewSheet3 = Sheets.Add(After:=SrcSheet)
        NewSheet3.Name = "3 line defs"
        Set NewSheet4 = Sheets.Add(After:=SrcSheet)
        NewSheet4.Name = "4 line defs"
        Set NewSheet5 = Sheets.Add(After:=SrcSheet)
        NewSheet5.Name = "5+ line defs"
    
'macro must be run with the data sheet as the currently active sheet
    Set SrcSheet = ActiveSheet
    Set SrcRange = SrcSheet.Columns(1)
    Set startCell = SrcRange.Find(What:="County", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, MatchCase:=False)
       
    Do Until startCell Is Nothing
       
'**** Somehow do a count on this command below and not include any line starting description to get a number, which I can then evaluate in a case statement*****
        SrcSheet.Range(startCell.Row & ":" & SrcSheet.Range("A" & SrcSheet.Rows.Count).End(xlUp).Row).EntireRow.Cut _
            NewSheet.Range("A2")    'adjust this range as where you want the data cut to (if not starting in A2)
'**** Use a case statement to write to the relevant sheet 1,2,3,4,5+ ****
        Set startCell = SrcRange.Previous
       
    Loop
End Sub

Test Source

Column to be operated on

object-group 1

a

object-group 2ythiop

description this is some descriptive text

c c c

object-group 3000001

d d d d d

e

f f f f

object-group 4 which is a new group

g

object-group 5

h h h h

I I I

 

[Joe4]

I need some help to modify this please. It's a great bit of code, but I can't figure out how to tweak it to what I want.

I have a dataset - it's basically a configuration document and what I would like to do is as follows

1) Run through the config, which is all in Col A, look for a keyword and extract the subset of data under the keyword out to the relevant sheet already created dependent on how many rows there are in the dataset.
2) The sheets are 1,2,3,4,5+ and relate to how may rows are in the definition
3) Make sure it strips out any row that starts with description from the count, but include it in the transfer to the new location

I've uploaded a screenshot - hopefully making it clear what I am looking to achieve and the original code from above

Sub SplitConfigFile()
Dim SrcSheet As Worksheet, NewSheet As Worksheet
Dim SrcRange As Range, startCell As Range

'Create new sheets to be used
        Set NewSheet1 = Sheets.Add(After:=SrcSheet)
        NewSheet1.Name = "1 line defs"
        Set NewSheet2 = Sheets.Add(After:=SrcSheet)
        NewSheet2.Name = "2 line defs"
        Set NewSheet3 = Sheets.Add(After:=SrcSheet)
        NewSheet3.Name = "3 line defs"
        Set NewSheet4 = Sheets.Add(After:=SrcSheet)
        NewSheet4.Name = "4 line defs"
        Set NewSheet5 = Sheets.Add(After:=SrcSheet)
        NewSheet5.Name = "5+ line defs"
   
'macro must be run with the data sheet as the currently active sheet
    Set SrcSheet = ActiveSheet
    Set SrcRange = SrcSheet.Columns(1)
    Set startCell = SrcRange.Find(What:="County", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, MatchCase:=False)
      
    Do Until startCell Is Nothing
      
'**** Somehow do a count on this command below and not include any line starting description to get a number, which I can then evaluate in a case statement*****
        SrcSheet.Range(startCell.Row & ":" & SrcSheet.Range("A" & SrcSheet.Rows.Count).End(xlUp).Row).EntireRow.Cut _
            NewSheet.Range("A2")    'adjust this range as where you want the data cut to (if not starting in A2)
'**** Use a case statement to write to the relevant sheet 1,2,3,4,5+ ****
        Set startCell = SrcRange.Previous
      
    Loop
End Sub

Test Source

Column to be operated on

object-group 1

a

object-group 2ythiop

description this is some descriptive text

c c c

object-group 3000001

d d d d d

e

f f f f

object-group 4 which is a new group

g

object-group 5

h h h h

I I I

The person who posted that code has not been active here in a while. I am not sure if they are still active.
As such, it would probably better for you to start a new thread (and you can provide a link to reference this one here if you like), so it appears as a new, unanswered question instead of resurrecting a thread which has not been active in almost 10 years!