Hello all. I hope you can help me. I am currently writing some VBA
code to merge multiple spreadsheets together from various sources and
convert them into a single fixed format. What I want to do is filter
the contents of a spreadsheet using a distinct set of values from a
specific column.

The Autofilter function does this and the drop down contains a list of
unique values but I need to extract those unique values and use them
inconjuction with a loop to filter and process those rows. I have been
looking through various sites and books but I have not found a solution
to the problem.

I would be grateful for any help.


--
Golgo 13
------------------------------------------------------------------------
Golgo 13's Profile: http://www.excelforum.com/member.php...o&userid=26448
View this thread: http://www.excelforum.com/showthread...hreadid=397191

Hi Golgo

I use AdvancedFilter to do this in this macro and loop through the list
You can use a part of the code in your macro
http://www.rondebruin.nl/copy5.htm#all

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Golgo 13" wrote in message
...

Hello all. I hope you can help me. I am currently writing some VBA
code to merge multiple spreadsheets together from various sources and
convert them into a single fixed format. What I want to do is filter
the contents of a spreadsheet using a distinct set of values from a
specific column.

The Autofilter function does this and the drop down contains a list of
unique values but I need to extract those unique values and use them
inconjuction with a loop to filter and process those rows. I have been
looking through various sites and books but I have not found a solution
to the problem.

I would be grateful for any help.


--
Golgo 13
------------------------------------------------------------------------
Golgo 13's Profile: http://www.excelforum.com/member.php...o&userid=26448
View this thread: http://www.excelforum.com/showthread...hreadid=397191

Ron, I am using your macro and get an error message on the line:

rng.Columns(29).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("IV1"), Unique:=True

Columns(29) or "AC" is the last column in my currentregion and the
header row is "AC4". What do I change to make this work? TIA

Greg

Hi GregR

Set rng = ws1.Range("A1").CurrentRegion '<<< Change

Change this to

Set rng = ws1.Range("A4").CurrentRegion '<<< Change

--
Regards Ron de Bruin
http://www.rondebruin.nl


"GregR" wrote in message oups.com...
Ron, I am using your macro and get an error message on the line:

rng.Columns(29).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("IV1"), Unique:=True

Columns(29) or "AC" is the last column in my currentregion and the
header row is "AC4". What do I change to make this work? TIA

Greg

Read this also

Important:
1) Always use unique headers in the first row of your data table
2) Don't use empty rows in your data table
3) Have an empty row above, below and a empty column next to your data table
4) Don't use merged cells in your table


--
Regards Ron de Bruin
http://www.rondebruin.nl


"GregR" wrote in message oups.com...
Ron, I am using your macro and get an error message on the line:

rng.Columns(29).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("IV1"), Unique:=True

Columns(29) or "AC" is the last column in my currentregion and the
header row is "AC4". What do I change to make this work? TIA

Greg

Ron, same error, here is the complete code:

Sub Copy_With_AdvancedFilter_To_Worksheets()
Dim CalcMode As Long
Dim ws1 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim Lrow As Long

Set ws1 = Sheets("POLOG") '<<< Change
'Tip : Use a Dynamic range name,
http://www.contextures.com/xlNames01.html#Dynamic
'or a fixed range like Range("A1:H1200")
Set rng = ws1.Range("A4").CurrentRegion '<<< Change

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With ws1
rng.Columns(29).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("IV1"), Unique:=True
'This example filter on the first column in the range (change
this if needed)
'You see that the last two columns of the worksheet are used to
make a Unique list
'and add the CriteriaRange.(you can't use this macro if you use
the columns)

Lrow = .Cells(Rows.Count, "IV").End(xlUp).Row
.Range("IU1").Value = .Range("IV1").Value

For Each cell In .Range("IV2:IV" & Lrow)
.Range("IU2").Value = cell.Value
Set WSNew = Sheets.Add
On Error Resume Next
WSNew.Name = cell.Value
If err.number 0 Then
MsgBox "Change the name of : " & WSNew.Name & "
manually"
err.Clear
End If
On Error GoTo 0
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("IU1:IU2"), _
CopyToRange:=WSNew.Range("A1"), _
Unique:=False
WSNew.Columns.Autofit
Next
.Columns("IU:IV").Clear
End With

With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub

I have unique headers
no empty rows
no merged cells
the current region is the whole used area, except for the first three
rows. TIA

Greg

Is row 3 empty ?

--
Regards Ron de Bruin
http://www.rondebruin.nl


"GregR" wrote in message oups.com...
Ron, same error, here is the complete code:

Sub Copy_With_AdvancedFilter_To_Worksheets()
Dim CalcMode As Long
Dim ws1 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim Lrow As Long

Set ws1 = Sheets("POLOG") '<<< Change
'Tip : Use a Dynamic range name,
http://www.contextures.com/xlNames01.html#Dynamic
'or a fixed range like Range("A1:H1200")
Set rng = ws1.Range("A4").CurrentRegion '<<< Change

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With ws1
rng.Columns(29).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("IV1"), Unique:=True
'This example filter on the first column in the range (change
this if needed)
'You see that the last two columns of the worksheet are used to
make a Unique list
'and add the CriteriaRange.(you can't use this macro if you use
the columns)

Lrow = .Cells(Rows.Count, "IV").End(xlUp).Row
.Range("IU1").Value = .Range("IV1").Value

For Each cell In .Range("IV2:IV" & Lrow)
.Range("IU2").Value = cell.Value
Set WSNew = Sheets.Add
On Error Resume Next
WSNew.Name = cell.Value
If err.number 0 Then
MsgBox "Change the name of : " & WSNew.Name & "
manually"
err.Clear
End If
On Error GoTo 0
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("IU1:IU2"), _
CopyToRange:=WSNew.Range("A1"), _
Unique:=False
WSNew.Columns.Autofit
Next
.Columns("IU:IV").Clear
End With

With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub

I have unique headers
no empty rows
no merged cells
the current region is the whole used area, except for the first three
rows. TIA

Greg

the list is the autofilter is not available for extract.

You can get a unique list by using the Advanced filter.

You might have a look at the code at Ron de Bruin's site:

http://www.rondebruin.nl/copy5.htm

--
Regards,
Tom Ogilvy


"Golgo 13" wrote in
message ...

Hello all. I hope you can help me. I am currently writing some VBA
code to merge multiple spreadsheets together from various sources and
convert them into a single fixed format. What I want to do is filter
the contents of a spreadsheet using a distinct set of values from a
specific column.

The Autofilter function does this and the drop down contains a list of
unique values but I need to extract those unique values and use them
inconjuction with a loop to filter and process those rows. I have been
looking through various sites and books but I have not found a solution
to the problem.

I would be grateful for any help.


--
Golgo 13
------------------------------------------------------------------------
Golgo 13's Profile:
http://www.excelforum.com/member.php...o&userid=26448
View this thread: http://www.excelforum.com/showthread...hreadid=397191