I am in the process of trying to learn VBA. I am trying to write a macro
that will go through a list of data in excel and:

1. Sort Data
2. Find duplicates
3.If duplicates are found, move certain information to open column of the
master row
4. Delete Duplicate row

Problem

Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1 DFLT-1 Mfg ID-2
0804706 BETCOCHEM AF79
0804706 JOHNSONSON 4605
0810295 CARLISLE 3663300
0810295 CARLISLE (O)4155900

Hopefull End result

Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1
0804706 BETCOCHEM AF79 JOHNSONSON 4605
0810295 CARLISLE 3663300 CARLISLE (O)4155900

There will be multiple items that need to be moved to multiple columns.
Bottom line is that I am trying to create unique item numbers that could have
multiple part numbers.

Any help would be much appreciated.

thanks,

bob

See if this code helps you out. It works with a given array, but you can
make an array from a worksheet range and working with arrays is faster
in any case.
You may need some alterations to suit your particular needs.

RBS


Function SwingArray(ByRef arr1 As Variant, _
ByRef colToTest As Long, _
ByRef DoSort As Boolean, _
ByRef StartCol As Long, _
Optional ByRef lDiscardLastCols As Long = 0) _
As Variant

'takes one multi-column 2D array and swings the elements
'that have the same value in colToTest to the row where
'this value was found first. Column colToTest will only
'hold unique values in the resulting array.
'StartCol is the column where the copying of the elements
'starts from.
'--------------------------------------------------------
Dim arr2()
Dim i As Long
Dim n As Long
Dim c As Long
Dim c2 As Long
Dim c3 As Long
Dim maxItems As Long
Dim uCo As Long
Dim LBR1 As Long
Dim UBR1 As Long
Dim LBC1 As Long
Dim UBC1 As Long
Dim tempIdx As Long
Dim arrError(0 To 0)

On Error GoTo ERROROUT

LBR1 = LBound(arr1, 1)
UBR1 = UBound(arr1, 1)
LBC1 = LBound(arr1, 2)
UBC1 = UBound(arr1, 2) - lDiscardLastCols

'adjust UBR1 to account for empty elements
'these empty element have to be at the
'bottom of the array if they are there
'-----------------------------------------
For i = LBR1 To UBR1
If arr1(i, colToTest) = Empty Then
UBR1 = i - 1
Exit For
End If
Next

'sorting the supplied array ascending
'------------------------------------
If DoSort = True Then
If PreSort2DArray(arr1, _
"A", _
colToTest) = False Then
On Error GoTo 0
SwingArray = False
Exit Function
End If
End If

'find and mark the doubles
'get the maximum number of doubles
'---------------------------------
tempIdx = arr1(LBR1, colToTest)

For i = LBR1 + 1 To UBR1
If Not arr1(i, colToTest) = tempIdx Then
tempIdx = arr1(i, colToTest)
uCo = uCo + 1
c2 = 0
Else
arr1(i, LBC1) = 0
c2 = c2 + 1
If c2 maxItems Then
maxItems = c2
End If
End If
Next

'adjust the final array
'LBound will be as the original array
'------------------------------------
ReDim arr2(LBR1 To uCo + LBR1, _
LBC1 To (UBC1) + maxItems * _
(((UBC1 + 1) - StartCol)))

n = LBR1 - 1

'swing the elements from vertical to horizontal
'----------------------------------------------
For i = LBR1 To UBR1
If Not arr1(i, LBC1) = 0 Then
'copy first row in full
n = n + 1
For c = LBC1 To UBC1
arr2(n, c) = arr1(i, c)
Next
c3 = UBC1 + 1
Else
'copy subsequent rows from specified start column
'------------------------------------------------
For c = StartCol To UBC1
arr2(n, c3) = arr1(i, c)
c3 = c3 + 1
Next
End If
Next

SwingArray = arr2

On Error GoTo 0
Exit Function
ERROROUT:

arrError(0) = "ERROR"
SwingArray = arrError

On Error GoTo 0
End Function

Function PreSort2DArray(ByRef avArray, _
ByRef sOrder As String, _
ByRef iKey As Long, _
Optional ByRef iLow1 As Long = -1, _
Optional ByRef iHigh1 As Long = -1) _
As Boolean

'the routine procSort2D can't handle large arrays
'causing an error out of stack space
'this is handled by sorting increasing larger parts
'of the array, so that there is less to be done when
'the whole array gets sorted
'---------------------------------------------------

Dim LR As Long
Dim lPreSorts As Long
Dim lArrayChunk As Long
Dim n As Long

LR = UBound(avArray)

'this value may depend on the hardware
'-------------------------------------
lArrayChunk = 8000

'no need to do pre-sorts
'-----------------------
If LR < lArrayChunk Then
PreSort2DArray = procSort2D(avArray, _
sOrder, _
iKey, _
iLow1, _
iHigh1)
Exit Function
End If

lPreSorts = LR \ lArrayChunk

For n = 0 To lPreSorts
If n < lPreSorts Then
'increase the part of the array in steps of lArrayChunk
'------------------------------------------------------
PreSort2DArray = procSort2D(avArray, _
sOrder, _
iKey, _
iLow1, _
(n + 1) * lArrayChunk)
Else
'sort the whole array
'--------------------
PreSort2DArray = procSort2D(avArray, _
sOrder, _
iKey, _
iLow1, _
iHigh1)
End If
Next

End Function

Function procSort2D(ByRef avArray, _
ByRef sOrder As String, _
ByRef iKey As Long, _
Optional ByRef iLow1 As Long = -1, _
Optional ByRef iHigh1 As Long = -1) _
As Boolean

Dim iLow2 As Long
Dim iHigh2 As Long
Dim i As Long
Dim vItem1 As Variant
Dim vItem2 As Variant

On Error GoTo ERROROUT

If iLow1 = -1 Then
iLow1 = LBound(avArray, 1)
End If

If iHigh1 = -1 Then
iHigh1 = UBound(avArray, 1)
End If

'Set new extremes to old extremes
iLow2 = iLow1
iHigh2 = iHigh1

'Get value of array item in middle of new extremes
vItem1 = avArray((iLow1 + iHigh1) \ 2, iKey)

'Loop for all the items in the array between the extremes
While iLow2 < iHigh2

If sOrder = "A" Then
'Find the first item that is greater than the mid-point item
While avArray(iLow2, iKey) < vItem1 And iLow2 < iHigh1
iLow2 = iLow2 + 1
Wend

'Find the last item that is less than the mid-point item
While avArray(iHigh2, iKey) vItem1 And iHigh2 iLow1
iHigh2 = iHigh2 - 1
Wend
Else
'Find the first item that is less than the mid-point item
While avArray(iLow2, iKey) vItem1 And iLow2 < iHigh1
iLow2 = iLow2 + 1
Wend

'Find the last item that is greater than the mid-point item
While avArray(iHigh2, iKey) < vItem1 And iHigh2 iLow1
iHigh2 = iHigh2 - 1
Wend
End If

'If the two items are in the wrong order, swap the rows
If iLow2 < iHigh2 Then
For i = LBound(avArray) To UBound(avArray, 2)
vItem2 = avArray(iLow2, i)
avArray(iLow2, i) = avArray(iHigh2, i)
avArray(iHigh2, i) = vItem2
Next
End If

'If the pointers are not together, advance to the next item
If iLow2 <= iHigh2 Then
iLow2 = iLow2 + 1
iHigh2 = iHigh2 - 1
End If
Wend

'Recurse to sort the lower half of the extremes
If iHigh2 iLow1 Then
procSort2D avArray, _
sOrder, _
iKey, _
iLow1, _
iHigh2
End If

'Recurse to sort the upper half of the extremes
If iLow2 < iHigh1 Then
procSort2D avArray, _
sOrder, _
iKey, _
iLow2, _
iHigh1
End If

procSort2D = True

Exit Function
ERROROUT:

procSort2D = False

End Function



"Bob Kopp" <Bob wrote in message
...
I am in the process of trying to learn VBA. I am trying to write a macro
that will go through a list of data in excel and:

1. Sort Data
2. Find duplicates
3.If duplicates are found, move certain information to open column of the
master row
4. Delete Duplicate row

Problem

Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1 DFLT-1 Mfg ID-2
0804706 BETCOCHEM AF79
0804706 JOHNSONSON 4605
0810295 CARLISLE 3663300
0810295 CARLISLE (O)4155900

Hopefull End result

Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1
0804706 BETCOCHEM AF79 JOHNSONSON 4605
0810295 CARLISLE 3663300 CARLISLE (O)4155900

There will be multiple items that need to be moved to multiple columns.
Bottom line is that I am trying to create unique item numbers that could
have
multiple part numbers.

Any help would be much appreciated.

thanks,

bob

Bob,

Here is something to get you started.
This code takes A1 to B20 and sorts it in ascending order based on column A.
It then steps through and clears entire rows when it reaches a duplicate
value incolumn A. As for moving the duplicate information to another
location, that will need to be worked out prior to deleting the entire row.

Sub RemoveDuplicate()

Range("A1:B20").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo,
_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

colnum = Selection(1).Column
For rowndx = Selection(Selection.Cells.Count).Row To _
Selection(1).Row + 1 Step -1
c = "A" & Cells(rowndx, colnum).Row
If Cells(rowndx, colnum).Value = Cells(rowndx - 1, colnum).Value
Then

'Additional code to move data to another location would go here

Range(c).EntireRow.Delete
End If
Next rowndx

End Sub





"Bob Kopp" <Bob wrote in message
...
I am in the process of trying to learn VBA. I am trying to write a macro
that will go through a list of data in excel and:

1. Sort Data
2. Find duplicates
3.If duplicates are found, move certain information to open column of the
master row
4. Delete Duplicate row

Problem

Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1 DFLT-1 Mfg ID-2
0804706 BETCOCHEM AF79
0804706 JOHNSONSON 4605
0810295 CARLISLE 3663300
0810295 CARLISLE (O)4155900

Hopefull End result

Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1
0804706 BETCOCHEM AF79 JOHNSONSON 4605
0810295 CARLISLE 3663300 CARLISLE (O)4155900

There will be multiple items that need to be moved to multiple columns.
Bottom line is that I am trying to create unique item numbers that could
have
multiple part numbers.

Any help would be much appreciated.

thanks,

bob

Maybe you need an example to see how this works.
If we take the data as in your example, without the fields it would go like
this:

Sub Test()

Dim arr

arr = Range(Cells(1), Cells(4, 3))
arr = SwingArray(arr, 1, False, 2, 0)
Range(Cells(5), Cells(UBound(arr), 4 + UBound(arr, 2))) = arr

End Sub


RBS

"Bob Kopp" <Bob wrote in message
...
I am in the process of trying to learn VBA. I am trying to write a macro
that will go through a list of data in excel and:

1. Sort Data
2. Find duplicates
3.If duplicates are found, move certain information to open column of the
master row
4. Delete Duplicate row

Problem

Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1 DFLT-1 Mfg ID-2
0804706 BETCOCHEM AF79
0804706 JOHNSONSON 4605
0810295 CARLISLE 3663300
0810295 CARLISLE (O)4155900

Hopefull End result

Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1
0804706 BETCOCHEM AF79 JOHNSONSON 4605
0810295 CARLISLE 3663300 CARLISLE (O)4155900

There will be multiple items that need to be moved to multiple columns.
Bottom line is that I am trying to create unique item numbers that could
have
multiple part numbers.

Any help would be much appreciated.

thanks,

bob

RB Smissaert

I am playing with the code you provided me, but I am still very much a
noivce when it comes to the VBA programing language.

bob

"Bob Kopp" wrote:

I am in the process of trying to learn VBA. I am trying to write a macro
that will go through a list of data in excel and:

1. Sort Data
2. Find duplicates
3.If duplicates are found, move certain information to open column of the
master row
4. Delete Duplicate row

Problem

Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1 DFLT-1 Mfg ID-2
0804706 BETCOCHEM AF79
0804706 JOHNSONSON 4605
0810295 CARLISLE 3663300
0810295 CARLISLE (O)4155900

Hopefull End result

Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1
0804706 BETCOCHEM AF79 JOHNSONSON 4605
0810295 CARLISLE 3663300 CARLISLE (O)4155900

There will be multiple items that need to be moved to multiple columns.
Bottom line is that I am trying to create unique item numbers that could have
multiple part numbers.

Any help would be much appreciated.

thanks,

bob

You don't have to understand it and the example I gave should work.
Only if you have to make adjustments will it need some understanding
what is going on. In that case just post back to this NG.

RBS

"Bob Kopp" wrote in message
...
RB Smissaert

I am playing with the code you provided me, but I am still very much a
noivce when it comes to the VBA programing language.

bob

"Bob Kopp" wrote:

I am in the process of trying to learn VBA. I am trying to write a macro
that will go through a list of data in excel and:

1. Sort Data
2. Find duplicates
3.If duplicates are found, move certain information to open column of the
master row
4. Delete Duplicate row

Problem

Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1 DFLT-1 Mfg ID-2
0804706 BETCOCHEM AF79
0804706 JOHNSONSON 4605
0810295 CARLISLE 3663300
0810295 CARLISLE (O)4155900

Hopefull End result

Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1
0804706 BETCOCHEM AF79 JOHNSONSON 4605
0810295 CARLISLE 3663300 CARLISLE (O)4155900

There will be multiple items that need to be moved to multiple columns.
Bottom line is that I am trying to create unique item numbers that could
have
multiple part numbers.

Any help would be much appreciated.

thanks,

bob

RBS

When I run the code that you just sent me to create the array, It gets hung
up on line:

Range(Cells(5), Cells(UBound(arr), 4 + UBound(arr, 2))) = arr

Also would I have to rename arr to arr1 in order for it to get read by the
previous code that you sent me? If not, how does the array that this code
creates get brought into that code?

thanks,

bob

"RB Smissaert" wrote:

You don't have to understand it and the example I gave should work.
Only if you have to make adjustments will it need some understanding
what is going on. In that case just post back to this NG.

RBS

"Bob Kopp" wrote in message
...
RB Smissaert

I am playing with the code you provided me, but I am still very much a
noivce when it comes to the VBA programing language.

bob

"Bob Kopp" wrote:

I am in the process of trying to learn VBA. I am trying to write a macro
that will go through a list of data in excel and:

1. Sort Data
2. Find duplicates
3.If duplicates are found, move certain information to open column of the
master row
4. Delete Duplicate row

Problem

Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1 DFLT-1 Mfg ID-2
0804706 BETCOCHEM AF79
0804706 JOHNSONSON 4605
0810295 CARLISLE 3663300
0810295 CARLISLE (O)4155900

Hopefull End result

Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1
0804706 BETCOCHEM AF79 JOHNSONSON 4605
0810295 CARLISLE 3663300 CARLISLE (O)4155900

There will be multiple items that need to be moved to multiple columns.
Bottom line is that I am trying to create unique item numbers that could
have
multiple part numbers.

Any help would be much appreciated.

thanks,

bob

Did you have your example data in the range starting at A1?
It works fine with me.

Also would I have to rename arr to arr1 in order for it to get read by the
previous code that you sent me?

No, it doesn't matter how you call the array in the example Sub.
There is no relation between the array names in the function and the array
name in the calling Sub.

If you have the data in range A1 : C4 and run this Sub:

Sub Test()

Dim arr
Dim lStartPasteCol As Long

lStartPasteCol = 5

arr = Range(Cells(1), Cells(4, 3))
arr = SwingArray(arr, 1, False, 2, 0)
Range(Cells(lStartPasteCol), _
Cells(UBound(arr), _
(lStartPasteCol - 1) + UBound(arr, 2))) = arr

End Sub

It should just work fine.


RBS



"Bob Kopp" wrote in message
...
RBS

When I run the code that you just sent me to create the array, It gets
hung
up on line:

Range(Cells(5), Cells(UBound(arr), 4 + UBound(arr, 2))) = arr

Also would I have to rename arr to arr1 in order for it to get read by the
previous code that you sent me? If not, how does the array that this code
creates get brought into that code?

thanks,

bob

"RB Smissaert" wrote:

You don't have to understand it and the example I gave should work.
Only if you have to make adjustments will it need some understanding
what is going on. In that case just post back to this NG.

RBS

"Bob Kopp" wrote in message
...
RB Smissaert

I am playing with the code you provided me, but I am still very much a
noivce when it comes to the VBA programing language.

bob

"Bob Kopp" wrote:

I am in the process of trying to learn VBA. I am trying to write a
macro
that will go through a list of data in excel and:

1. Sort Data
2. Find duplicates
3.If duplicates are found, move certain information to open column of
the
master row
4. Delete Duplicate row

Problem

Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1 DFLT-1 Mfg ID-2
0804706 BETCOCHEM AF79
0804706 JOHNSONSON 4605
0810295 CARLISLE 3663300
0810295 CARLISLE (O)4155900

Hopefull End result

Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1
0804706 BETCOCHEM AF79 JOHNSONSON 4605
0810295 CARLISLE 3663300 CARLISLE (O)4155900

There will be multiple items that need to be moved to multiple
columns.
Bottom line is that I am trying to create unique item numbers that
could
have
multiple part numbers.

Any help would be much appreciated.

thanks,

bob

RBS

Thanks, that worked much better. I had titles in the first row when I ran
the macro and it did not like it. I just have to figure out how to delete
the row of data that I just moved for a particular item before it performs
the same action on the next row (item).

Data before Macro

0804706 BETCOCHEM AF79
0804706 JOHNSONSON 4605
0810295 CARLISLE 3663300
0810295 CARLISLE (O)4155900

Data after Macro

0804706 BETCOCHEM AF79 804706 BETCOCHEM AF79 JOHNSONSON 4605
0804706 JOHNSONSON 4605 810295 CARLISLE 3663300 CARLISLE (O)4155900
0810295 CARLISLE 3663300
0810295 CARLISLE (O)4155900

The Mfg info for item 0810295 got put on the same line as item 0804706.
After the data gets moved I need to delete row that the data was moved from.
I will have items with 4 or more MFG info that needs to be transcribed to one
item number.

You have been a great help so far and I appreciate your patience.

thanks,

bob




"RB Smissaert" wrote:

Did you have your example data in the range starting at A1?
It works fine with me.

Also would I have to rename arr to arr1 in order for it to get read by the
previous code that you sent me?

No, it doesn't matter how you call the array in the example Sub.
There is no relation between the array names in the function and the array
name in the calling Sub.

If you have the data in range A1 : C4 and run this Sub:

Sub Test()

Dim arr
Dim lStartPasteCol As Long

lStartPasteCol = 5

arr = Range(Cells(1), Cells(4, 3))
arr = SwingArray(arr, 1, False, 2, 0)
Range(Cells(lStartPasteCol), _
Cells(UBound(arr), _
(lStartPasteCol - 1) + UBound(arr, 2))) = arr

End Sub

It should just work fine.


RBS



"Bob Kopp" wrote in message
...
RBS

When I run the code that you just sent me to create the array, It gets
hung
up on line:

Range(Cells(5), Cells(UBound(arr), 4 + UBound(arr, 2))) = arr

Also would I have to rename arr to arr1 in order for it to get read by the
previous code that you sent me? If not, how does the array that this code
creates get brought into that code?

thanks,

bob

"RB Smissaert" wrote:

You don't have to understand it and the example I gave should work.
Only if you have to make adjustments will it need some understanding
what is going on. In that case just post back to this NG.

RBS

"Bob Kopp" wrote in message
...
RB Smissaert

I am playing with the code you provided me, but I am still very much a
noivce when it comes to the VBA programing language.

bob

"Bob Kopp" wrote:

I am in the process of trying to learn VBA. I am trying to write a
macro
that will go through a list of data in excel and:

1. Sort Data
2. Find duplicates
3.If duplicates are found, move certain information to open column of
the
master row
4. Delete Duplicate row

Problem

Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1 DFLT-1 Mfg ID-2
0804706 BETCOCHEM AF79
0804706 JOHNSONSON 4605
0810295 CARLISLE 3663300
0810295 CARLISLE (O)4155900

Hopefull End result

Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1
0804706 BETCOCHEM AF79 JOHNSONSON 4605
0810295 CARLISLE 3663300 CARLISLE (O)4155900

There will be multiple items that need to be moved to multiple
columns.
Bottom line is that I am trying to create unique item numbers that
could
have
multiple part numbers.

Any help would be much appreciated.

thanks,

bob

I just have to figure out how to delete the row of data that I just moved
for a particular item before it performs the same action on the next row
(item).

You don't have to delete any rows.
If you want the data to go the same range as the original data you can do
something like this:
Again using the same data, without the fields.

Sub Test()

Dim rngOriginal As Range
Dim arr
Dim lStartPasteCol As Long

Set rngOriginal = Range(Cells(1), Cells(4, 3))
lStartPasteCol = 1

arr = rngOriginal
arr = SwingArray(arr, 1, False, 2, 0)
rngOriginal.Clear
Range(Cells(lStartPasteCol), _
Cells(UBound(arr), _
(lStartPasteCol - 1) + UBound(arr, 2))) = arr

End Sub

In general it is always best to do as much work in arrays and not in ranges
as it will be faster.
If needed you could add some code to deal with the fields.


RBS


"Bob Kopp" wrote in message
...
RBS

Thanks, that worked much better. I had titles in the first row when I ran
the macro and it did not like it. I just have to figure out how to delete
the row of data that I just moved for a particular item before it performs
the same action on the next row (item).

Data before Macro

0804706 BETCOCHEM AF79
0804706 JOHNSONSON 4605
0810295 CARLISLE 3663300
0810295 CARLISLE (O)4155900

Data after Macro

0804706 BETCOCHEM AF79 804706 BETCOCHEM AF79 JOHNSONSON 4605
0804706 JOHNSONSON 4605 810295 CARLISLE 3663300 CARLISLE (O)4155900
0810295 CARLISLE 3663300
0810295 CARLISLE (O)4155900

The Mfg info for item 0810295 got put on the same line as item 0804706.
After the data gets moved I need to delete row that the data was moved
from.
I will have items with 4 or more MFG info that needs to be transcribed to
one
item number.

You have been a great help so far and I appreciate your patience.

thanks,

bob




"RB Smissaert" wrote:

Did you have your example data in the range starting at A1?
It works fine with me.

Also would I have to rename arr to arr1 in order for it to get read by
the
previous code that you sent me?

No, it doesn't matter how you call the array in the example Sub.
There is no relation between the array names in the function and the
array
name in the calling Sub.

If you have the data in range A1 : C4 and run this Sub:

Sub Test()

Dim arr
Dim lStartPasteCol As Long

lStartPasteCol = 5

arr = Range(Cells(1), Cells(4, 3))
arr = SwingArray(arr, 1, False, 2, 0)
Range(Cells(lStartPasteCol), _
Cells(UBound(arr), _
(lStartPasteCol - 1) + UBound(arr, 2))) = arr

End Sub

It should just work fine.


RBS



"Bob Kopp" wrote in message
...
RBS

When I run the code that you just sent me to create the array, It gets
hung
up on line:

Range(Cells(5), Cells(UBound(arr), 4 + UBound(arr, 2))) = arr

Also would I have to rename arr to arr1 in order for it to get read by
the
previous code that you sent me? If not, how does the array that this
code
creates get brought into that code?

thanks,

bob

"RB Smissaert" wrote:

You don't have to understand it and the example I gave should work.
Only if you have to make adjustments will it need some understanding
what is going on. In that case just post back to this NG.

RBS

"Bob Kopp" wrote in message
...
RB Smissaert

I am playing with the code you provided me, but I am still very much
a
noivce when it comes to the VBA programing language.

bob

"Bob Kopp" wrote:

I am in the process of trying to learn VBA. I am trying to write a
macro
that will go through a list of data in excel and:

1. Sort Data
2. Find duplicates
3.If duplicates are found, move certain information to open column
of
the
master row
4. Delete Duplicate row

Problem

Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm ID-1 DFLT-1 Mfg ID-2
0804706 BETCOCHEM AF79
0804706 JOHNSONSON 4605
0810295 CARLISLE 3663300
0810295 CARLISLE (O)4155900

Hopefull End result

Item Mfg ID Mfg Itm ID Mfg ID-1 Mfg Itm
ID-1
0804706 BETCOCHEM AF79 JOHNSONSON 4605
0810295 CARLISLE 3663300 CARLISLE (O)4155900

There will be multiple items that need to be moved to multiple
columns.
Bottom line is that I am trying to create unique item numbers that
could
have
multiple part numbers.

Any help would be much appreciated.

thanks,

bob