ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Extracting only when column contains a certain value (https://www.excelbanter.com/excel-programming/360019-extracting-only-when-column-contains-certain-value.html)

AmyTaylor[_54_]

Extracting only when column contains a certain value
 

Dear all, please see attached code for automating extracting data from a
range (called "database").
It is working perfectly, however what I want to add is a line to say
only extract the data when column X in the "database" contains value
"01".
Is that possible?
Please let me know if you can help
Love AMY XX

Sub ExtractReps()
'Application.ScreenUpdating = False
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim R As Integer
Dim c As Range
Set ws1 = Sheets("PCT Specific Data")
Set rng = Range("Database")

'extract a list of PCTs
ws1.Columns("H:H").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("BA1"), Unique:=True
R = Cells(Rows.Count, "BA").End(xlUp).Row

'set up Criteria Area
Range("BC1").Value = Range("H1").Value
While R < 301
Wend
For Each c In Range("BA2:BA300")
'For Each c In Range("BA2:BA" & r)
'add the rep name to the criteria area
ws1.Range("BC2").Value = c.Value
'add new sheet and run advanced filter
Set wsNew = Sheets.Add
wsNew.Move After:=Worksheets(Worksheets.Count)
wsNew.Name = c.Value
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("PCT Specific Data").Range("BC1:BC2"), _
CopyToRange:=wsNew.Range("A1"), _
Unique:=False
Next
ws1.Select
ws1.Columns("BA:BC").Delete
'Application.ScreenUpdating = True
End Sub


--
AmyTaylor
------------------------------------------------------------------------
AmyTaylor's Profile: http://www.excelforum.com/member.php...o&userid=20970
View this thread: http://www.excelforum.com/showthread...hreadid=537134


Dave Ramage

Extracting only when column contains a certain value
 
Amy,

Expand your criteria range to BC1:BD2 and set BD1 to [Title Column X], and
BC2 to "*01*" (excluding quotes).

Also, look out for the infinite loop in your code if less than 301 unique
items are found.

Cheers,
Dave

"AmyTaylor" wrote:


Dear all, please see attached code for automating extracting data from a
range (called "database").
It is working perfectly, however what I want to add is a line to say
only extract the data when column X in the "database" contains value
"01".
Is that possible?
Please let me know if you can help
Love AMY XX

Sub ExtractReps()
'Application.ScreenUpdating = False
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim R As Integer
Dim c As Range
Set ws1 = Sheets("PCT Specific Data")
Set rng = Range("Database")

'extract a list of PCTs
ws1.Columns("H:H").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("BA1"), Unique:=True
R = Cells(Rows.Count, "BA").End(xlUp).Row

'set up Criteria Area
Range("BC1").Value = Range("H1").Value
While R < 301
Wend
For Each c In Range("BA2:BA300")
'For Each c In Range("BA2:BA" & r)
'add the rep name to the criteria area
ws1.Range("BC2").Value = c.Value
'add new sheet and run advanced filter
Set wsNew = Sheets.Add
wsNew.Move After:=Worksheets(Worksheets.Count)
wsNew.Name = c.Value
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("PCT Specific Data").Range("BC1:BC2"), _
CopyToRange:=wsNew.Range("A1"), _
Unique:=False
Next
ws1.Select
ws1.Columns("BA:BC").Delete
'Application.ScreenUpdating = True
End Sub


--
AmyTaylor
------------------------------------------------------------------------
AmyTaylor's Profile: http://www.excelforum.com/member.php...o&userid=20970
View this thread: http://www.excelforum.com/showthread...hreadid=537134




All times are GMT +1. The time now is 09:06 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com