Search code examples
excelexcel-2013vba

How to copy rows from a range if the cell value starts with particular string?

I have a list with with 1000's of geographical parameters - which will vary according to the file type - in a single column. I would like to copy the rows which starts with strings "File, Geometry, Feature Count, Layer SRS, GEOGCS, PROJGCS, etc... " (Image) to the next column. Few parameters, for eg - PROJGCS might be present for one file but not for another one.

enter image description here

Solution

  • You could use Advanced Filter, something like this:

    Sub FilterThings()
'Add header row and call it something
Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").FormulaR1C1 = "Bananas"

'Create named range to use in filter
ActiveWorkbook.Names.Add Name:="Source", RefersToR1C1:=Replace(Range("A1").CurrentRegion.Address(True, True, xlR1C1, True), "[" & ActiveWorkbook.Name & "]", "=")

'Add in criteria
Range("P1").FormulaR1C1 = "Bananas"
Range("P2").FormulaR1C1 = "=""File*"""
Range("P3").FormulaR1C1 = "=""Geometry*"""
Range("P4").FormulaR1C1 = "=""Feature Count*"""
Range("P5").FormulaR1C1 = "=""Layer SRS*"""
Range("P6").FormulaR1C1 = "=""GEOGCS*"""
Range("P7").FormulaR1C1 = "=""PROJGCS*"""

'Create named range to use in filter
ActiveWorkbook.Names.Add Name:="Criteria", RefersToR1C1:=Replace(Range("P1").CurrentRegion.Address(True, True, xlR1C1, True), "[" & ActiveWorkbook.Name & "]", "=")

'Filter to Location
Range("Source").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("Criteria"), CopyToRange:=Range("G1")

'Delete Criteria column
Columns("P:P").Delete Shift:=xlToLeft

'Delete Header Bananas row
Rows("1:1").Delete Shift:=xlUp

'Delete named ranges
ActiveWorkbook.Names("Criteria").Delete
ActiveWorkbook.Names("Extract").Delete
ActiveWorkbook.Names("Source").Delete
End Sub

    You could substitute Bananas for something else or leave that part out if you already have a header. Here I assumed your data was just in column A starting at row 1 and have arbitrarily put it in Column G, this and where you put the Criteria could be changed with no adverse effect.