Transfer AutoFiler list to a ComboBox

[Lemi]

Hi,

I now use Excel 2007. I have a Data Table with 12 columns. When you make the
AutoFilter on and click one of the column headings you can see the list of
unique records checked under Select All.
I want to transfer/add this list (with none-blanks excluded) to a ComboBox
in a UserForm for further processing in the module.
I did this several years ago by extracting the unique records for a single
column from a table using Database Extract method in Office XP, but my old
code does not work on Excel 2007. Can you please help me with this part of
the macro code for Excel 2007? How can I show the unique records (sorted A
to Z) under a single column of a data table in a ComboBox or ListBox?

Thank you very much in advance.

Regards/Lemi

 

[OssieMac]

Hi Lemi,

Do I interpret your request correctly in that you want ot create a unique
list of data from a current list that is not unique. You then want to sort
the unique list and use it for the combo box row source? If so then try the
following.

I have included a number of comments to help you to understand what the code
is doing but feel free to get back to me with any questions.

Note that a space and underscore at the end of a line is a line break in an
otherwise single line of code.

Sub CreateUniqueList()

'Define name for original data
'Assumes original data in column A
'starting with column header in cell A1.
With Sheets("Sheet1")
.Range(.Cells(1, "A"), _
.Cells(.Rows.Count, "A") _
.End(xlUp)).Name = "MyData"
End With

'Use another worksheet for unique data
With Sheets("Sheet2")
'Advanced Filter to extract
'unique records
Range("MyData").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("A1"), _
Unique:=True

'Define name for unique data
'including column header.
.Range(.Cells(1, "A"), _
.Cells(.Rows.Count, "A") _
.End(xlUp)).Name = "UniqHeadAndDat"

'Define a name for the data ony
'excluding the column header.
.Range(.Cells(2, "A"), _
.Cells(.Rows.Count, "A") _
.End(xlUp)).Name = "UniqueDatOnly"

'Clear any existing sort fields.
.Sort.SortFields.Clear

'Set the sort parameters.
.Sort.SortFields _
.Add Key:=.Range("UniqueDatOnly"), _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal

'Sort the data.
With .Sort
.SetRange Range("UniqHeadAndDat")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With

UserForm1.ComboBox1.rowsource = "UniqueDatOnly"
End Sub

 

[OssieMac]

Hello again Lemi,

Immediatley after this the line of code
With Sheets("Sheet2")

Add this line of code.
..Columns("A:A").ClearContents


Reason is that the old unique list needs to be removed before creating a new
one in case the new list is shorter than the old list.

My apologies for the omission in the original code.

 

[Lemi]

Hi OssieMac,

I was just loosing my hopes to get an answer when I received you message,
thank you very much.
Yes, you have understood me correctly but your code fails at the following
line under "With Sheets("Sheet2")" with a message: "Run-time error
1004:Application-defined or Object defined error"

Range("MyData").AdvancedFilter _

Action:=xlFilterCopy, _
CopyToRange:=.Range("A1"), _
Unique:=True

As a matter of fact, this is exactly the same situation with my own code
too. In my opinion, the reason is that Excel2007 (unlike previous versions
such as Excel2002) does not allow the data to be extracted to another sheet.
Could this be the reason?


On the other hand, I have another remark which I made in my first message to
the group as well:

Put an Auto-Filter onto the heading of data in Sheet1 and Click the arrow:
it shows the list in unique records and sorted alphabetically too. That is
what we are trying to do by the code! Now, if Excel is doing this by a
built-in function we should then be able to use the same function in order
to feed the list directly to a combo box instead of writing a code for
filtering and extracting and sorting the data. This was my point.

I await for your comments please.

Regards,
Lemi

 

[OssieMac]

Hi Lemi,

The code was developed and tested in xl2007. I even deleted all the defined
names and tested to ensure that it would run for you without the need to
define any names first. (The sort part of the code will not run in earlier
versions of xl.)

Using defined names as I have coded this allows the Advanced Filter to work
with different worksheets.

When I posted the amendment did you include the dot in front of Columns
because if not it will produce the error you reported if it deleted the
source data.

Did you make any alterations to the code? If so and it does not work then
post the code with your alterations and I will have a look at it and see if I
can determine what the problem is.

I'll post the code again including the amendment. Try it again.

Sub CreateUniqueList()

'Define name for original data
'Assumes original data in column A
'starting with column header in cell A1.
With Sheets("Sheet1")
.Range(.Cells(1, "A"), _
.Cells(.Rows.Count, "A") _
.End(xlUp)).Name = "MyData"
End With

'Use another worksheet for unique data
With Sheets("Sheet2")
.Columns("A:A").ClearContents
'Advanced Filter to extract
'unique records
Range("MyData").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("A1"), _
Unique:=True

'Define name for unique data
'including column header.
.Range(.Cells(1, "A"), _
.Cells(.Rows.Count, "A") _
.End(xlUp)).Name = "UniqHeadAndDat"

'Define a name for the data ony
'excluding the column header.
.Range(.Cells(2, "A"), _
.Cells(.Rows.Count, "A") _
.End(xlUp)).Name = "UniqueDatOnly"

'Clear any existing sort fields.
.Sort.SortFields.Clear

'Set the sort parameters.
.Sort.SortFields _
.Add Key:=.Range("UniqueDatOnly"), _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal

'Sort the data.
With .Sort
.SetRange Range("UniqHeadAndDat")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With

UserForm1.ComboBox1.rowsource = "UniqueDatOnly"
End Sub

 

[OssieMac]

On your second question, I don't think that it can be done but if it can be
done then I don't know how.

 

[Lemi]

Hi OssieMac,

You're right, the code works OK. Probably I made a mistake during copy &
paste and rearranging the lines.
This time I have copied & pasted exactly as it is and it works.

Thank you very much for your valuable help and I am sorry to give this
inconvenience to you.

Now it is my turn again to find out why my own programme does not work in
Excel 2007 while it works in Office XP for several years. I thought this
could be the reason in the beginning. Because when you record a test macro
using the advanced filter from the ribbon, it copies the filtered data only
to a range in the same worksheet. It says:"Copying to another worksheet is
not allowed". Therefore I have focused only to this instance from the
beginning.
Maybe I am stuck to this point only and cannot see where the real problem
is. Also strange is that I don't get any error message when I run the
programme in Excel2007. Instead it does not function as it is supposed to
function with the current dataset. It is supposed to deliver data to an
empty report sheet, which is extracted from the main dataset using diffrent
criteria with advanced filter. Now it delivers only empty lines to the
report sheet, there are only the column headings nothing else.

Anyway, is there any chance for me to send this old workbook to you as an
attachement for your evaluation? Because the complete workbook and the code
is rather long to list here and the case is still left as a mystery to me.

Regards,
Lemi

 

[OssieMac]

Hi Lemi,

I am not prepared to post an email address here. However, if you want to get
a hotmail or gmail or whatever that you can abandon if you get spam on it and
post it here then I will reply to give you an address that will contact me.

When posting the email address don't enter it as a specific address but
something like myaddress and it is at hotmail. That way those that use
programs to trawl the internet for addresses miss picking it up.

By the way I also have computer with Office XP (xl2002) so I can test in
both XP and xl2007 and I am only too happy to assist you.

 

[Lemi]

Thank you very much OssieMac,

Put my first and and family names together (without any dot in between) then
use superonline.com as the domain. That is my address.

Regards,

Lemi Ozden