PDA

View Full Version : VBA to identify unique values



kevvukeka
06-05-2013, 05:23 AM
Hi All,

I could get this code in google to assign unique values from a list to array. How can I edit this to specific range in a column of excel worksheet.

I want the unique items in that column to be assigned to this array. I tried assigning array_1=range("Ab2",range("ab2").end(xldown))

but it fails at "If UBound(Filter(Array_1, eleArr_1)) = 0 Then"

can any one help...



Sub Remove_All_Duplicated()
Dim Array_1

Array_1 = Array("pedro", "maria", "jose", "jesus", "pepe", "pepe", "jose")
Dim Array_2()


Dim eleArr_1, x
x = 0
For Each eleArr_1 In
Array_1
If UBound(Filter(Array_1, eleArr_1)) = 0
Then
ReDim Preserve
Array_2(x)
Array_2(x) =
eleArr_1
x = x +
1
End If
Next eleArr_1


End Sub

GarysStudent
06-05-2013, 06:00 AM
To avoid having to deal with two dimensional arrays, consider filling Array_1 as follows:

Dim rAB As Range, HowMany As Long, r As Range
Set rAB = Range(Range("AB2"), Range("AB2").End(xlDown))
HowMany = rAB.Count
ReDim Array_1(0 To HowMany - 1)
For Each r In rAB
Array_1(k) = r.Value
k = k + 1
Next r

p45cal
06-05-2013, 06:52 AM
try:Array_1 = Application.Transpose(Range("Ab2", Range("ab2").End(xlDown)))
It's a single dimension array.

I like your loop!
Most people, when talking about a list of unique items would expect to see, from your list, this:
pedro
maria
jose
jesus
pepe
(the same would be produced with Advanced Filter, Unique records only)

Your loop produces this:
pedro
maria
jesus

which is a list of values which occur only once in the starting array.
It's a perfectly valid interpretation of creating a list of values which are unique in another list.

Is it what you want?
If not, come back and I'll give you a snippet to give you the longer list, probably using a collection or dictionary object.

kevvukeka
06-06-2013, 02:36 AM
Hi P45cal and Garystudent,

Thanks for the help. How should I extract the values in the array from your code. I need the unique values stored in array to use for a for formula. So how can I use these unique value in the " for each value in array" kind of loop. I tried to write to use a variable to extract it but it is not working.

for .eg

dim cel2 as variant
for each cel2 in array_1
'My task goes here.

p45cal
06-06-2013, 03:13 AM
Your code already works. Here's your code again with:
1. The substitution suggested in my last message
2. An extra line added to place array_2 values on the sheet alongside AB2, just to show you what's in the array.

But is it the kind of unique list you want, as previously asked in my last message?
Sub Remove_All_Duplicated()
Dim Array_1
Array_1 = Application.Transpose(Range("Ab2", Range("ab2").End(xlDown))) '<< substituted line.
'Array_1 = Array("pedro", "maria", "jose", "jesus", "pepe", "pepe", "jose")
Dim Array_2()

Dim eleArr_1, x
x = 0
For Each eleArr_1 In Array_1
If UBound(Filter(Array_1, eleArr_1)) = 0 Then
ReDim Preserve Array_2(x)
Array_2(x) = eleArr_1
x = x + 1
End If
Next eleArr_1
Range("Ac2").Resize(UBound(Array_2) + 1) = Application.Transpose(Array_2) '<<< added line.
End Sub

kevvukeka
06-06-2013, 03:57 AM
Hi P45cal,

I tried you latest code and instead of AC2 for the output I used BL2. But the code didn't gave the output. To give a brief idea of what I am doing here it is.

I have a raw data sheet with 36000 rows. In this AB column contains the names of few companies. it would be around 14 unique values. Now for each of this company I need to add up data in column AG which contain some billed amount and export this data to new sheet.
So basicall I wanted to create the unique list from AB and column use it a loop and try a sumproduct. But I am not able to achive that.

the attached file may give you an idea..

p45cal
06-06-2013, 04:05 AM
You want a pivot table as in the attached. Took about 30 secs. No code or formulae required at all.

kevvukeka
06-06-2013, 04:31 AM
Yeah I did this too. But thing is We need fruit name in filters and when I change I each filter, thte dat will change, that data for that particular filter will be exported to new sheet. I knew I could do this with a pivot, but the requirement was to automatically change each filter in that pivot and export the data for each pivot to a new sheet automatically. I couldn't make how can I automate the changing filter in pivot... I tried the below one it not working.



Public Sub Filter()
Application.ScreenUpdating =
False



Dim pt As PivotTable
Dim pi As
PivotItem
Dim pf As PivotField


For Each pt In
ActiveSheet.PivotTables

'goes through each pivot table on the
sheet
Set pf =
pt.PivotFields("Provider Name")

For Each pi In pf.PivotItems
'goes through every item in the field "Date"
If Not pi.Name = "(blank)"
Then

pi.Visible =
True



' my task of copying the relevant data of that filter goes
here

Else

'do
nothing


End If
Next
pi
Next pt

Application.ScreenUpdating = True
End Sub

p45cal
06-06-2013, 06:06 AM
Two buttons in the attached to get you started.

kevvukeka
06-06-2013, 10:49 PM
Hi P45cal,

I was looking exactly something near to this. As beginner I couldn't make it perfectly as you did. Please find attached the report which will give the final thing. I have added a region to it. now I will be changing the filter each time for each region and copy the below pivot data to a new sheet for reach region.

I am sorry I took much of your time on this. I would like thefilter for region at the to loop one at a time.

Thanks so much for your help..

snb
06-07-2013, 12:45 AM
If you are a beginner why not starting with some less complex questions ?

kevvukeka
06-07-2013, 01:29 AM
I apologize snb. These are the scenarios which I get struck at my work. I didn't had any training in vba but I was moved to this role directly. so handling this automation is getting hectic for me. That's the reason I apporoach vbax at such times..

I learn vba through google on a daily basis so that's the reason my vba coding is not so perfect.

snb
06-07-2013, 01:33 AM
My advise to learn VBA is : take a course on the fundamentals, study a basic VBA book. It saves you a lot of time googling, trial & error etc.

kevvukeka
06-07-2013, 02:03 AM
Could you suggest one plzz? I will buy it....

snb
06-07-2013, 03:15 AM
E.g. Excel 2007 VBA; programmer's reference , John Green et.al Wiley 2007.
or books written on VBA by Guy Hart Davis, publisher: Sybex

kevvukeka
06-07-2013, 03:30 AM
Hi Snb,

Thanks.. I will get any of these..

Hi P45cal,

Can you help on the last part of the code for changing filters at the top as requested in my last post here..

Thanks,

p45cal
06-07-2013, 03:44 AM
P45cal,
Can you help on the last part of the code for changing filters at the top as requested in my last post here..Later today.

kevvukeka
06-07-2013, 03:50 AM
Ok Thank you....

p45cal
06-07-2013, 01:01 PM
now I will be changing the filter each time for each region and copy the below pivot data to a new sheet for reach region.Are we talking:

For each region
For each Company Name

Produce a new sheet
Next Company NameNext Region



or:



For each region

Produce one new sheet of all companies for that region
Next region

kevvukeka
06-08-2013, 02:07 AM
For each region

Produce one new sheet of all companies for that region
Next region

p45cal
06-08-2013, 03:56 AM
For the file you supplied in msg#10:Sub blah()
Set pt = ActiveSheet.PivotTables(1)
Set pf = pt.PageFields(1)
For Each pit In pf.PivotItems
pf.CurrentPage = pit.Name
Set newsht = Sheets.Add(after:=Sheets(Sheets.Count))
newsht.Name = pit.Name & " " & Format(Now, "d-mmm-yyyy hh-mm-ss")
Union(pt.DataBodyRange.Offset(, -1).Resize(, 2), pt.PageRange).Copy newsht.Range("A1")
newsht.Columns("A:B").AutoFit
Next pit
pf.ClearAllFilters
End Sub
If you have filtered anything (apart from the page fields) in the pivot table those filters remain in place while copying to the new sheets.
Because pt.PageRange and pt.DataBodyRange.Offset(, -1).Resize(, 2) are both 2 columns wide in this instance, there is no problem copying them in one shot, if they were different columns widths we'd need to tweak.
I've included grand totals but they don't have to be.

kevvukeka
06-08-2013, 12:24 PM
Hi P45cal,

Thanks so much for your help... I can add my code after the lines
pf.CurrentPage = pit.Name

Thanks again...