I was surprised to find three or four code samples that did a similar thing as below, but was unable to adapt the monsters to my sheet.

Here is what I want to do.
With columns A & B:

Change this

GL14 x
GL15
GL15
GL15
GL16 x
GL17
GL17


to this

GL14 x
GL15 3
GL16 x
GL17 2

Whe if there is text in column B leave A and B as is.
Whe there were three GL15's before, reduce to one GL15 with a count of how may there was to begin with.

The codes I could find were pretty much multiple employee ID numbers in A and hours worked in B, then add all the hours for same ID and return a single ID in A and the total hours for that ID in B.

Thanks.
Howard

Hi Howard,

Am Fri, 21 Feb 2014 21:46:36 -0800 (PST) schrieb L. Howard:

Change this

GL14 x
GL15
GL15
GL15
GL16 x
GL17
GL17


to this

GL14 x
GL15 3
GL16 x
GL17 2

try:

Option Explicit
Option Base 1

Sub Test_CB()
Dim LRow As Long
Dim arrIn As Variant
Dim arrOut() As Variant
Dim myArr As Variant
Dim dic As Object
Dim i As Long

LRow = Cells(Rows.Count, 1).End(xlUp).Row
arrIn = Range("A1:B" & LRow)
Set dic = CreateObject("Scripting.Dictionary")

For i = 1 To UBound(arrIn, 1)
dic.item(arrIn(i, 1)) = arrIn(i, 1)
Next

myArr = dic.items
For i = 0 To UBound(myArr)
ReDim Preserve arrOut(dic.Count, 2)
arrOut(i + 1, 1) = myArr(i)
With WorksheetFunction
If .VLookup(myArr(i), Range("A1:B" & LRow), 2, 0) = 0 Then
arrOut(i + 1, 2) = .CountIf(Range("A1:A" & LRow), myArr(i))
Else
arrOut(i + 1, 2) = .VLookup(myArr(i), Range("A1:B" & LRow),
2, 0)
End If
End With
Next
Range("C1").Resize(dic.Count, 2) = arrOut
End Sub

The code will give you unique values and the number of these values in
column C:D


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Hi Howard,

Am Sat, 22 Feb 2014 10:31:47 +0100 schrieb Claus Busch:

Sub Test_CB()

or write the values from sheet1 without duplicates to sheet2 and
calculate the number of occurence:

Sub Test_CB2()
Dim LRow As Long
Dim myArr As Variant
Dim rngC As Range

With Sheets("Sheet1")
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
myArr = .Range("A1:B" & LRow)
End With

With Sheets("Sheet2")
.Range("A1").Resize(LRow, 2) = myArr
.Range("A1:B" & LRow).RemoveDuplicates _
Columns:=Array(1, 2), Header:=xlNo
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For Each rngC In .Range("B1: B" & LRow)
If Len(rngC) = 0 Then
rngC = WorksheetFunction.CountIf(Sheets("Sheet1") _
.Range("A1:A" & LRow), rngC.Offset(, -1))
End If
Next
End With
End Sub


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Hi Howard,

Am Sat, 22 Feb 2014 11:10:52 +0100 schrieb Claus Busch:

found an error. Try instead
Sub Test_CB2()

found an error. Try instead

Sub Test_CB2()
Dim LRow1 As Long, LRow2 As Long
Dim myArr As Variant
Dim rngC As Range

With Sheets("Sheet1")
LRow1 = .Cells(.Rows.Count, 1).End(xlUp).Row
myArr = .Range("A1:B" & LRow1)
End With

With Sheets("Sheet2")
.Range("A1").Resize(LRow1, 2) = myArr
.Range("A1:B" & LRow1).RemoveDuplicates _
Columns:=Array(1, 2), Header:=xlNo
LRow2 = .Cells(.Rows.Count, 1).End(xlUp).Row
For Each rngC In .Range("B1: B" & LRow2)
If Len(rngC) = 0 Then
rngC = WorksheetFunction.CountIf(Sheets("Sheet1") _
.Range("A1:A" & LRow1), rngC.Offset(, -1))
End If
Next
End With
End Sub


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

On Saturday, February 22, 2014 2:14:44 AM UTC-8, Claus Busch wrote:
Hi Howard,

found an error. Try instead

Sub Test_CB2()


Hi Claus,

The Test_CB is excellent!!
A work of art to me.

The Test_CB2 is puzzling to me. Not sure what the results should look like.

If I run the code on this data on sheet 1

P-1
P-2
P-3 x
P-5
P-6
P-7 x
P-8
P-9
P-10 x
P-1
P-2
P-3 x
P-5
P-6
P-7 x
P-8
P-9
P-10 x


I get this on sheet 2.

P-1
P-2
P-3 x
P-5
P-6
P-7 x
P-8
P-9
P-10 x
P-1
P-2
P-3 x
P-5
P-6
P-7 x
P-8
P-9
P-10 x
#N/A #N/A

And an error alert Invalid procedure call or argument

I did change all the A1's and B1's to A2's and B2's to avoid headers. Did the same with Test_CB and it works well.

Howard

Hi Howard,

Am Sat, 22 Feb 2014 06:47:12 -0800 (PST) schrieb L. Howard:

The Test_CB2 is puzzling to me. Not sure what the results should look like.

in the first answer Test_CB2 has an error
I tried your example with the second answer and the fixed error and I
get:
P-1 2
P-2 2
P-3 x
P-5 2
P-6 2
P-7 x
P-8 2
P-9 2
P-10 x



Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Hi Howard,

Am Sat, 22 Feb 2014 06:47:12 -0800 (PST) schrieb L. Howard:

P-1
P-2
P-3 x
P-5
P-6
P-7 x
P-8
P-9
P-10 x
P-1
P-2
P-3 x
P-5
P-6
P-7 x
P-8
P-9
P-10 x

in your first posting you wrote you want to keep the values in A if B
has text.
How about your example? Do you want to keep P3 or P7 two times?


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

On Saturday, February 22, 2014 6:53:48 AM UTC-8, Claus Busch wrote:
Hi Howard,



Am Sat, 22 Feb 2014 06:47:12 -0800 (PST) schrieb L. Howard:



The Test_CB2 is puzzling to me. Not sure what the results should look like.



in the first answer Test_CB2 has an error

I tried your example with the second answer and the fixed error and I

get:

P-1 2

P-2 2

P-3 x

P-5 2

P-6 2

P-7 x

P-8 2

P-9 2

P-10 x







Regards

Claus B.

--

Hi Claus,

This would be great for a sheet 2 result, really it is the same as a sheet 1 isn't it?

Not sure why my book won't do that??

I tried your example with the second answer and the fixed error and I
get:
P-1 2
P-2 2
P-3 x
P-5 2
P-6 2
P-7 x
P-8 2
P-9 2
P-10 x


Howard

Hi Howard,

Am Sat, 22 Feb 2014 07:44:14 -0800 (PST) schrieb L. Howard:

This would be great for a sheet 2 result, really it is the same as a sheet 1 isn't it?

the result is the same as in sheet1.
Please have a look:
https://skydrive.live.com/#cid=9378A...121822A3%21326
for "UniqueValues"

There are 3 macros. The two you know and another one to keep all values
from A if in B is text.


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

On Saturday, February 22, 2014 7:52:14 AM UTC-8, Claus Busch wrote:
Hi Howard,



Am Sat, 22 Feb 2014 07:44:14 -0800 (PST) schrieb L. Howard:



This would be great for a sheet 2 result, really it is the same as a sheet 1 isn't it?



the result is the same as in sheet1.

Please have a look:

https://skydrive.live.com/#cid=9378A...121822A3%21326

for "UniqueValues"



There are 3 macros. The two you know and another one to keep all values

from A if in B is text.





Regards

Claus B.

--

Hi Claus,

I do believe I got it figured out.

Test_CB2 doesn't like Option Base 1

All seems to be working fine now.

Not sure if Test_CB3 is needed, but I will indeed hang on to it.

Thanks Claus, your magic wand works once again. Nice indeed.

Regards,
Howard

Hi Howard,

Am Sat, 22 Feb 2014 08:42:19 -0800 (PST) schrieb L. Howard:

All seems to be working fine now.

Not sure if Test_CB3 is needed, but I will indeed hang on to it.

if CB3 is not needed I would prefer CB
Like yesterday you can also delete column A:B if the array is filled and
write the array back to these columns


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

On Saturday, February 22, 2014 8:48:29 AM UTC-8, Claus Busch wrote:
Hi Howard,



Am Sat, 22 Feb 2014 08:42:19 -0800 (PST) schrieb L. Howard:



All seems to be working fine now.



Not sure if Test_CB3 is needed, but I will indeed hang on to it.



if CB3 is not needed I would prefer CB

Like yesterday you can also delete column A:B if the array is filled and

write the array back to these columns





Regards

Claus B.

--

Win XP PRof SP2 / Vista Ultimate SP2

Office 2003 SP2 /2007 Ultimate SP2

I like the results in C & D.

Howard

On Saturday, February 22, 2014 9:44:04 AM UTC-8, L. Howard wrote:
On Saturday, February 22, 2014 8:48:29 AM UTC-8, Claus Busch wrote:

Hi Howard,







Am Sat, 22 Feb 2014 08:42:19 -0800 (PST) schrieb L. Howard:







All seems to be working fine now.







Not sure if Test_CB3 is needed, but I will indeed hang on to it.







if CB3 is not needed I would prefer CB



Like yesterday you can also delete column A:B if the array is filled and



write the array back to these columns











Regards



Claus B.



--



Win XP PRof SP2 / Vista Ultimate SP2



Office 2003 SP2 /2007 Ultimate SP2



I like the results in C & D.



Howard

A question, please.

Reference to Test_CB2 which returns results to sheet 2.
Would you know why if I change all the A1's and B1's to A2 and B2 in the code it would produce these results?

The bad data is the same number of rows as the good.

This A 14 row excerpt from the bottom of correctly returned data to the next 7 rows of some corrupt data.


P-3745 AA-1248
P-3746 2
P-3747 2
P-3748 AA-1249
P-3749 2
P-3750 2
P-3751 AA-1250
0
0
0
0
0
0
0

And this is the last entry of the bad data:

#N/A #N/A


Howard

Hi Howard,

Am Sat, 22 Feb 2014 10:56:51 -0800 (PST) schrieb L. Howard:

Reference to Test_CB2 which returns results to sheet 2.
Would you know why if I change all the A1's and B1's to A2 and B2 in the code it would produce these results?

the duplicate in Row 15 will not be deleted. You have to change LRow1 to
LRow1 + 1:
With Sheets("Sheet2")
.Range("A2").Resize(LRow1, 2) = myArr
.Range("A2:B" & LRow1 + 1).RemoveDuplicates _
Columns:=Array(1, 2), Header:=xlNo


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

On Saturday, February 22, 2014 11:13:04 AM UTC-8, Claus Busch wrote:
Hi Howard,



Am Sat, 22 Feb 2014 10:56:51 -0800 (PST) schrieb L. Howard:



Reference to Test_CB2 which returns results to sheet 2.

Would you know why if I change all the A1's and B1's to A2 and B2 in the code it would produce these results?



the duplicate in Row 15 will not be deleted. You have to change LRow1 to

LRow1 + 1:

With Sheets("Sheet2")

.Range("A2").Resize(LRow1, 2) = myArr

.Range("A2:B" & LRow1 + 1).RemoveDuplicates _

Columns:=Array(1, 2), Header:=xlNo





Regards

Claus B.

--


I would have never found that. Now it does the work it's supposed to do but ends with the pair of #N/A's and type mismatch error pop up.

I'm lost again on what to look for. The usual suspects like dimming a string as a long or referring to a sheet that doesn't exist etc. are not apparent to me here, but I will keep looking.

Howard

Hi Howard,

Am Sat, 22 Feb 2014 12:04:37 -0800 (PST) schrieb L. Howard:

I would have never found that. Now it does the work it's supposed to do but ends with the pair of #N/A's and type mismatch error pop up.

have another look in SkyDrive. I changed the data to your last example
and for CB2 all rows(1) to rows(2)


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

On Saturday, February 22, 2014 12:12:48 PM UTC-8, Claus Busch wrote:
Hi Howard,



Am Sat, 22 Feb 2014 12:04:37 -0800 (PST) schrieb L. Howard:



I would have never found that. Now it does the work it's supposed to do but ends with the pair of #N/A's and type mismatch error pop up.



have another look in SkyDrive. I changed the data to your last example

and for CB2 all rows(1) to rows(2)





Regards

Claus B.

--
Hi Claus,

I do believe it is all anchored down and running fine.

Sure do appreciate it.

Howard

Hi Claus,

I have growing frustration over what appears to be a moving target of what the final out come is supposed to be, and of course I'm in over my head on the code.

Raw data in column A and as before move the non-P item up and over 1 row and 1 column.

So now data is in column A and column B (which is not shown below.)

Count the number of identical P-xxxx's with nothing in column B next to them and the number of identical P-xxxx's with ABCxxxx in column B next to them.

P-1234 ABC and P-1234 ABC would be 2.
P-4567 DEF and P-4567 HIJ would be 1 for each.
P-1357 XXX and P-1388 XXX would be 1 for each.

Those sum go in column C.

P-4352
P-3534
P-4568
ABCDE123
P-3333
P-5506
CDEFG234
P-4352
P-3534
P-4568
ABCDE124
P-7679
P-9852


P-9876 ABCDE 1
P-5678 FGRTTTRGF 1
P-7675 HFHFHFH 1
P-8901 ABCDE 1
P-8901 4
P-3456 1
P-6543 2
P-54463 1

The item in column B is a "serial number" so most likely all the P-xxxx with a
serial number in column C will be 1. But if you have a couple or three
P-9876 ABCDE's, for example, then that number should be in column C.

Notice P-8901 ABCDE and P-8901 are counted separate.

Once the count is completed then the duplicates can be removes to show as the column A, B, C example.

The data above shows format only. None of the final outcome data is actually part of the raw data. It is just a before and after view so to speak.

This is my last shot at this caper, I feel I've abused the privilege of the news group and your patience too much.

Thanks.

Howard

Test_CB2 doesn't like Option Base 1

Why would you deliberately declare this option?

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

On Saturday, February 22, 2014 6:52:44 PM UTC-8, GS wrote:
Test_CB2 doesn't like Option Base 1



Why would you deliberately declare this option?



--

Garry

Hi Garry,

If you are asking me, it's because Claus offer his code that way.

Howard

On Saturday, February 22, 2014 6:52:44 PM UTC-8, GS wrote:
Test_CB2 doesn't like Option Base 1



Why would you deliberately declare this option?



--

Garry

Hi Garry,

If you are asking me, it's because Claus offer his code that way.

Howard

Thanks.., I see that now though I don't see the why of it!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Hi Howard,

Am Sat, 22 Feb 2014 18:05:25 -0800 (PST) schrieb L. Howard:

I have growing frustration over what appears to be a moving target of what the final out come is supposed to be, and of course I'm in over my head on the code.

Raw data in column A and as before move the non-P item up and over 1 row and 1 column.

can you send me a workbook with the data and the expected result that I
can see it?


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Hi Howard,

Am Sat, 22 Feb 2014 18:05:25 -0800 (PST) schrieb L. Howard:

I have growing frustration over what appears to be a moving target of what the final out come is supposed to be, and of course I'm in over my head on the code.
Raw data in column A and as before move the non-P item up and over 1 row and 1 column.
So now data is in column A and column B (which is not shown below.)

I got it!
Change the For Each rngC Loop to:
..Range("C2:C" & LRow2).Formula = "=SumProduct(--(Sheet1!" _
& "$A$1:$A$" & LRow1 & "=A2),--(Sheet1!$B$1:$B$" & LRow1 & "= _
B2))"

Sub Test_CB2()
Dim LRow1 As Long, LRow2 As Long
Dim myArr As Variant

With Sheets("Sheet1")
LRow1 = .Cells(.Rows.Count, 1).End(xlUp).Row
myArr = .Range("A1:B" & LRow1)
End With

With Sheets("Sheet2")
.Range("A2").Resize(LRow1, 2) = myArr
.Range("A2:B" & LRow1 + 1).RemoveDuplicates _
Columns:=Array(1, 2), Header:=xlNo
LRow2 = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("C2:C" & LRow2).Formula = "=SumProduct(--(Sheet1!" _
& "$A$1:$A$" & LRow1 & "=A2),--(Sheet1!$B$1:$B$" & LRow1 & "=
B2))"
End With
End Sub


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

On Sunday, February 23, 2014 12:01:48 AM UTC-8, Claus Busch wrote:
Hi Howard,



Am Sat, 22 Feb 2014 18:05:25 -0800 (PST) schrieb L. Howard:



I have growing frustration over what appears to be a moving target of what the final out come is supposed to be, and of course I'm in over my head on the code.

Raw data in column A and as before move the non-P item up and over 1 row and 1 column.

So now data is in column A and column B (which is not shown below.)



I got it!

Change the For Each rngC Loop to:

.Range("C2:C" & LRow2).Formula = "=SumProduct(--(Sheet1!" _

& "$A$1:$A$" & LRow1 & "=A2),--(Sheet1!$B$1:$B$" & LRow1 & "= _

B2))"



Sub Test_CB2()

Dim LRow1 As Long, LRow2 As Long

Dim myArr As Variant



With Sheets("Sheet1")

LRow1 = .Cells(.Rows.Count, 1).End(xlUp).Row

myArr = .Range("A1:B" & LRow1)

End With



With Sheets("Sheet2")

.Range("A2").Resize(LRow1, 2) = myArr

.Range("A2:B" & LRow1 + 1).RemoveDuplicates _

Columns:=Array(1, 2), Header:=xlNo

LRow2 = .Cells(.Rows.Count, 1).End(xlUp).Row

.Range("C2:C" & LRow2).Formula = "=SumProduct(--(Sheet1!" _

& "$A$1:$A$" & LRow1 & "=A2),--(Sheet1!$B$1:$B$" & LRow1 & "=

B2))"

End With

End Sub





Regards

Claus B.

--


Yes that really seems to be the ticket.

All my testing says BINGO!

Really appreciate you efforts.

And of course all the code is noted with '/By Claus as I pass it on.

Thanks again.

Regards,
Howard

Hi Howard,

Am Sun, 23 Feb 2014 01:19:18 -0800 (PST) schrieb L. Howard:

All my testing says BINGO!

if you have same values in A with and without values in B macro Test_CB
doesn't give you the expected result because the value from A is only
once in the array.
With Test_CB2 you get the expected result but you use another sheet.
You can also copy the data from A:B to C:D and run RemoveDuplicates.
Then the code must be changed slightly.

If you want the output in the same sheet like Sheet1 in SkyDrive
workbook have another look in SkyDrive an go to Sheet4 and run Test_CB4


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Hi Garry,

Am Sat, 22 Feb 2014 22:24:39 -0500 schrieb GS:

Thanks.., I see that now though I don't see the why of it!

in the macro Test_CB2 I had no Option Base 1. But in the other macros I
had.
If I have 1D-Arrays (like the Scripting.Dictionary) into the code and
want to create 2D-Arrays out of them for me it seems easier to handle
with Option Base 1.
Now I have changed all codes (SkyDrive) to Option Base 0. ;-)


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Hi Garry,

Am Sat, 22 Feb 2014 22:24:39 -0500 schrieb GS:

Thanks.., I see that now though I don't see the why of it!

in the macro Test_CB2 I had no Option Base 1. But in the other macros
I had.
If I have 1D-Arrays (like the Scripting.Dictionary) into the code and
want to create 2D-Arrays out of them for me it seems easier to handle
with Option Base 1.
Now I have changed all codes (SkyDrive) to Option Base 0. ;-)


Regards
Claus B.

Hi Claus,
That makes sense to me but I found it to be problematic when the module
also required zero-based arrays that dealt with control indexes OR
recordsets from delimited text files where field names were the 1st
line in the file. If missing fieldnames I'd have to prepend a line to
the file contents before splitting into an array so the 1st record is
always 1 and the record count is always UBound.

What I find when working with 1D/2D arrays is that using a separate
counter works best for building the output array while the loop counter
starts at LBound. This allows easy transition going either way, IMO.<g

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Hi Garry,

Am Sun, 23 Feb 2014 11:50:21 -0500 schrieb GS:

What I find when working with 1D/2D arrays is that using a separate
counter works best for building the output array while the loop counter
starts at LBound. This allows easy transition going either way, IMO.<g

I am reading and writing here not only to help others. I do it also for
further learning. And your suggestions are always helpful and
instructive. Thank you.


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Hi Garry,

Am Sun, 23 Feb 2014 11:50:21 -0500 schrieb GS:

What I find when working with 1D/2D arrays is that using a separate
counter works best for building the output array while the loop
counter starts at LBound. This allows easy transition going either
way, IMO.<g

I am reading and writing here not only to help others. I do it also
for further learning. And your suggestions are always helpful and
instructive. Thank you.


Regards
Claus B.

Claus, please know this is mutual and you have been a great help to me
as well...

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Hi Claus,

Found a glitch that returns a subscript out of range.

This data errors:

P-3122
F3UT2BA000457 <note serial number here
P-3122
F3UT3C5000495
P-3122
F3UT3C4000059
P-3123
QBDA1C7000402

This data works fine:

P-3122
P-65439 <No serial number, P number instead
P-3122
F3UT3C5000495
P-3122
F3UT3C4000059
P-3123
QBDA1C7000402

If the FIRST P number entry has a serial number then it errors.
If the data starts with two non serial numbered P numbers it works fine.

I tried starting the error producing data in A2 and it worked but produces an error 400 AFTER the data is correctly handled on the sheet.

These are the codes I am using which have a few minor additions to what you wrote.

Thanks.
Howard


Option Explicit
Option Base 1

Sub MyScanA1()
'/ by Claus

Dim LRow As Long
Dim MyArr As Variant
Dim MyArr1 As Variant
Dim arrOut() As Variant
Dim i As Long, j As Long
Dim myCt As Long

Range("B:E").ClearContents

LRow = Cells(Rows.Count, 1).End(xlUp).Row

MyArr = Range("A2:A" & LRow)
myCt = WorksheetFunction.CountIf(Range("A2:A" & LRow), "P" & "*")

j = 1
For i = LBound(MyArr) To UBound(MyArr)

ReDim Preserve arrOut(myCt, 2)
If Left(MyArr(i, 1), 1) = "P" Then

arrOut(j, 1) = MyArr(i, 1)

j = j + 1

Else
arrOut(j - 1, 2) = MyArr(i, 1)

End If
Next

Range("A2:B" & LRow).ClearContents

Range("A2").Resize(UBound(arrOut), 2) = arrOut

'
ReScan
ClearLocateReturn

End Sub


Sub ClearLocateReturn()
Dim MyArr As Variant

MyArr = Range("C1", Range("E1").End(xlDown)).Value

Range("A:E").ClearContents

Range("A1").Resize(UBound(MyArr, 1), UBound(MyArr, 2)) = MyArr
End Sub


And in a standard module:

Option Explicit

Sub ReScan()
Dim LRow1 As Long, LRow2 As Long
Dim arrIn As Variant
Dim arrOut() As Variant
Dim MyArr As Variant
Dim dic As Object
Dim i As Long

'/Modify the sheet name
With Sheets("Sheet1")
LRow1 = .Cells(.Rows.Count, 1).End(xlUp).Row
arrIn = .Range("A1:B" & LRow1)
Set dic = CreateObject("Scripting.Dictionary")

For i = 1 To UBound(arrIn, 1)
dic.Item(arrIn(i, 1)) = arrIn(i, 1)
Next

MyArr = dic.items
For i = 0 To UBound(MyArr)
ReDim Preserve arrOut(dic.Count - 1, 1)
arrOut(i, 0) = MyArr(i)
arrOut(i, 1) = WorksheetFunction.VLookup(arrOut(i, 0), _
.Range("A1:B" & LRow1), 2, 0)
Next
.Range("C1").Resize(dic.Count, 2) = arrOut
LRow2 = .Cells(.Rows.Count, 3).End(xlUp).Row
With .Range("E1:E" & LRow2)
.Formula = "=SumProduct(--($A$1:$A$" & LRow1 & _
"=C1),--($B$1:$B$" & LRow1 & "= D1))"
.Value = .Value
End With
End With
End Sub

Hi Howard,

Am Mon, 24 Feb 2014 22:21:57 -0800 (PST) schrieb L. Howard:

P-3122
F3UT2BA000457 <note serial number here
P-3122
F3UT3C5000495
P-3122
F3UT3C4000059
P-3123
QBDA1C7000402

you are in the wrong thread ;-)

Your data starts in A1. Option Base 1 is NOT needed for the following
macro:

Sub MyScan5()
Dim LRow As Long
Dim myArr As Variant
Dim arrOut() As Variant
Dim i As Long, j As Long
Dim myCt As Long

LRow = Cells(Rows.Count, 1).End(xlUp).Row

myArr = Range("A1:A" & LRow)
myCt = WorksheetFunction.CountIf(Range("A1:A" & LRow), "P" & "*")

For i = LBound(myArr) To UBound(myArr)
ReDim Preserve arrOut(myCt - 1, 1)
If Left(myArr(i, 1), 1) = "P" Then
arrOut(j, 0) = myArr(i, 1)
j = j + 1
Else
arrOut(j - 1, 1) = myArr(i, 1)
End If
Next

Range("A1:B" & LRow).ClearContents
Range("A1").Resize(UBound(arrOut) + 1, 2) = arrOut

End Sub


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Hi Howard,

Am Mon, 24 Feb 2014 22:21:57 -0800 (PST) schrieb L. Howard:

P-3122
F3UT2BA000457 <note serial number here
P-3122
F3UT3C5000495
P-3122
F3UT3C4000059
P-3123
QBDA1C7000402

which macro errors out? The macro to put serial number to column B or
the macro for the unique values?
The first one I fixed with the last answer. The second one errors out if
you use the Test_CB because the unique values are created only from
column A. And in your case you only get 2 values back. I fixed it with
Test_CB4 and and Test_CB_2_2. I wrote this in an earlier answer.
Please have another look:
https://onedrive.live.com/?cid=9378A...121822A3%21326
for "UniqueValues" and look at the comments.

P.S.: SkyDrive changed to OneDrive. You can bookmark the link to
OneDrive if you use it often.


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

<which macro errors out? The macro to put serial number to column B or
<the macro for the unique values?

The one moving the serial number to column B.

I'll have a look at OneDrive.

Howard

Hi Howard,

Am Tue, 25 Feb 2014 01:06:48 -0800 (PST) schrieb L. Howard:

I'll have a look at OneDrive.

you can also look for
"ScanValues"


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

On Tuesday, February 25, 2014 1:16:45 AM UTC-8, Claus Busch wrote:
Hi Howard,



Am Tue, 25 Feb 2014 01:06:48 -0800 (PST) schrieb L. Howard:



I'll have a look at OneDrive.



you can also look for

"ScanValues"





Regards

Claus B.

--

Hi Claus,

It looks like running MyScan5 with a call to Test_CB4 does it all.

I'll look at Scan Values too.

Thanks.

Howard

Hi Claus,



It looks like running MyScan5 with a call to Test_CB4 does it all.



I'll look at Scan Values too.



Thanks.



Howard

Also MyScan5 and Test_CB looks like it gets it done too.

Howard

Hi Howard,

Am Tue, 25 Feb 2014 01:48:37 -0800 (PST) schrieb L. Howard:

Also MyScan5 and Test_CB looks like it gets it done too.

I wrote Test_CB because I thought the values in A are unique. As you
posted another example and there are same values in A with different
values in B I found that error. So the unique values are created only
from A some values are missing. In "UniqueValues" you see that 2 values
are missing. All other macros write 9 values, CB_Test only 7.
For your data that macro is wrong.

For this case I wrote Test_CB4 and Test_CB2_2.
CB2_2 works with RemoveDuplicates and is faster.
In "ScanValues" works a combination of Scan5 and TestCB2_2


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

On Tuesday, February 25, 2014 1:48:37 AM UTC-8, L. Howard wrote:
Hi Claus,







It looks like running MyScan5 with a call to Test_CB4 does it all.







I'll look at Scan Values too.







Thanks.







Howard



Also MyScan5 and Test_CB looks like it gets it done too.



Howard

I looked at this "ScanValues" and I don't know what could be better?

Thanks again.

Howard

Hi Claus,

Because some of the serial numbers just happen to start with "P" but NO serial number will state with "P-", I made that change in the code.

That errors out this line with a subscript out of range.

arrOut(j - 1, 1) = myArr(i, 1)

I made some random changes of the -1 and the other 1's but nothing worked.


myCt = WorksheetFunction.CountIf(.Range("A1:A" & LRow), "P-" & "*")

For i = LBound(myArr) To UBound(myArr)
ReDim Preserve arrOut(myCt - 1, 1)
If Left(myArr(i, 1), 1) = "P-" Then
arrOut(j, 0) = myArr(i, 1)
j = j + 1
Else

arrOut(j - 1, 1) = myArr(i, 1)

End If
Next

Howard

TYPO...

<NO serial number will state with "P-",

NO serial number will START with "P-",

H'wd