What I need to do is build a list of items, but seperated with
commas..

So..I have built this file to have a Brand, Model, Part criteria.
There is 53k or so entries or rows.

What I need to do is.. Sort each Part Number probably around 1200
Parts which will show me each Brand that takes that part in a list. I
need some sort of automation to create this list of Brands, but have
them seperated by commas.. For example..

These Part Numbers in Column C fit These Models in B and Brands in
Column A
Col-C P/N Col-B Model number Col-A Brand
1683 A altima
1683 B altima
1683 C altima
1683 D altima
1683 E snoma
1683 F snoma
1683 G snoma
1683 H snoma
1683 I tscny

As you can see there is some redundancy in the Brand Column on this
Part number.
What I need to do is have a final ouptut in a new colum look like
this.. 1683,altima,snoma,tscny


Any ideas on how to achieve this? I think Excel can handle it, but
I'm not sure. Please advise.

This is real simple. the only problem with this method is if you are
using Excel 2003 and there are more than 256 models that use the same
part number.


the Data you want is called CSV (Comma Seperate Values). the code
below will take your data from Sheet 1 and put the results in sheet 2.
the code first sorts the data by part number and then model number. It
the checks for duplicates and moves the unqiue data to sheet 2 with each
model number in a sperate column. All you will need to do is to save
the Sheet 2 data as SCV using the worksheet menu File - Saveas and
select as the file type CSV.

If you have more than 256 modules per part number I can easily modify
the code to put the comma between the data.




Sub MakeCSV()

NewRow = 0
With Sheets("Sheet1")
Lastrow = .Range("A" & Rows.Count).End(xlUp).Row
'sort data
.Rows("1:" & Lastrow).Sort _
header:=xlNo, _
key1:=.Range("C1"), _
order1:=xlAscending, _
key2:=.Range("C1"), _
order2:=xlAscending

OldPartNo = ""
OldModel = ""
For RowCount = 1 To Lastrow
PartNo = .Range("C" & RowCount)
Model = .Range("A" & RowCount)
With Sheets("sheet2")
If PartNo < OldPartNo Then
NewRow = NewRow + 1
.Range("A" & NewRow) = PartNo
OldPartNo = PartNo
.Range("B" & NewRow) = Model
OldModel = Model
Colcount = 3
Else
If Model < OldModel Then
.Cells(NewRow, Colcount) = Model
OldModel = Model
Colcount = Colcount + 1
End If
End If
End With
Next RowCount

End With

End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=154542

Microsoft Office Help

Wow, That's really some bada$$ code. Only a few have more than 255
models per part number. I'm unfortunately using Excel 2003. I went
ahead and saved the file as a CSV and opened in wordpad to see the
commas.. Many of the lines end like this one

56S23,knmore,kmart,outgmt,,,,

maybe we can just have excel add the commas so we don't have to delete
all those extra commas later.


I can't tell you how much time this has saved me, but maybe a month.


Thanks

I suspect the extra comma in the file is due to lines that didn't have
part numbers or models in columns A or C. I made a few minor changes

1) Test for blanks is column A and C
2) Put the results in column A with commas between the data

You can save the file as text to get your results.



Code:
--------------------
Sub MakeCSV()

NewRow = 0
With Sheets("Sheet1")
Lastrow = .Range("A" & Rows.Count).End(xlUp).Row
'sort data
.Rows("1:" & Lastrow).Sort _
header:=xlNo, _
key1:=.Range("C1"), _
order1:=xlAscending, _
key2:=.Range("C1"), _
order2:=xlAscending

OldPartNo = ""
OldModel = ""
For RowCount = 1 To Lastrow
PartNo = .Range("C" & RowCount)
Model = .Range("A" & RowCount)
If PartNo < "" And Model < "" Then
With Sheets("sheet2")
If PartNo < OldPartNo Then
NewRow = NewRow + 1
.Range("A" & NewRow) = PartNo
OldPartNo = PartNo
.Range("B" & NewRow) = Model
OldModel = Model
Else
If Model < OldModel Then
.Range("A" & NewRow) = _
.Range("A" & NewRow) & "," & Model
OldModel = Model
End If
End If
End With
End If
Next RowCount
End With

End Sub

--------------------


--
joel
------------------------------------------------------------------------
joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=154542

Microsoft Office Help

code works wonderfuly.. only thing I noticed is that when in excel it
doesn't put the comma in if it only has one brand entry, but when I
save it as csv it's all good. This is a huge huge help.


Thanks a ton,

Steve

Small change

from
.Range("A" & NewRow) = PartNo
OldPartNo = PartNo
.Range("B" & NewRow) = Model
OldModel = Model
to
.Range("A" & NewRow) = PartNo & "," & Model
OldPartNo = PartNo
OldModel = Model


"srosetti" wrote:

code works wonderfuly.. only thing I noticed is that when in excel it
doesn't put the comma in if it only has one brand entry, but when I
save it as csv it's all good. This is a huge huge help.


Thanks a ton,

Steve
.

You are not running with the latest version of the 1st macro that should
of fixed the problem with the commas. Re-Run the first macro again with
the code below. Then when the extra commas are removed go back and run
the 2nd macro.

Sub MakeCSV()

NewRow = 0
With Sheets("Sheet1")
Lastrow = .Range("A" & Rows.Count).End(xlUp).Row
'sort data
.Rows("1:" & Lastrow).Sort _
header:=xlNo, _
key1:=.Range("C1"), _
order1:=xlAscending, _
key2:=.Range("C1"), _
order2:=xlAscending

OldPartNo = ""
OldModel = ""
For RowCount = 1 To Lastrow
PartNo = .Range("C" & RowCount)
Model = .Range("A" & RowCount)
If PartNo < "" And Model < "" Then
With Sheets("sheet2")
If PartNo < OldPartNo Then
NewRow = NewRow + 1
.Range("A" & NewRow) = PartNo & "," & Model
OldPartNo = PartNo
OldModel = Model
Else
If Model < OldModel Then
.Range("A" & NewRow) = _
.Range("A" & NewRow) & "," & Model
OldModel = Model
End If
End If
End With
End If
Next RowCount
End With

End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=154542

Microsoft Office Help