View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Daniel M[_2_] Daniel M[_2_] is offline
external usenet poster
 
Posts: 12
Default macro for shifting/combining and arranging data


"Daniel M" wrote in message news:...
Thanks for the help. The macro works pretty well but i need some more

help.
First let me recap the task...

here is the data...


"Count","ComponentName","RefDes","Value","Descript ion"
"1","24PIN LCD CONNECTOR","J2","CON_LCD",""
"1","128MEG SDRAM 32X4 ","U2","",""
"4","SMT CAP 0402 100NF","C12","100nF",""
"","SMT CAP 0402 100NF","C18","100nF",""
"","SMT CAP 0402 100NF","C30","100nF",""
"","SMT CAP 0402 100NF","C33","100nF",""

The first row is the header. the following is the data. the range is
dynamic, meaning it could be 1 row or 30 rows long.

I need to format the data as below...

"Count","ComponentName","RefDes","Value","Descript ion"
"1","24PIN LCD CONNECTOR","J2","CON_LCD",""
"1","128MEG SDRAM 32X4 ","U2","",""
"4","SMT CAP 0402 100NF","C12, C18, C30, C33","100nF",""

basically here is what i need to do...compare the data from one row, and
ComponentName column. If the data is the same, update RefDes with the

RefDes
from the duplicate row.

IE: "4","SMT CAP 0402 100NF","C12","100nF",""
"","SMT CAP 0402 100NF","C18","100nF",""
should be...
"4","SMT CAP 0402 100NF","C12, C18","100nF",""

At this point the duplicate row should be deleted....side note: as you can
see the data already has some totalled "Count" numbers in the data. If the
data is out of order it may not have it totaled up correctly. what needs

to
be done here is clear the contents of the "Count" column and place a 1 in
the cell. This way we can increment the count column every time we add to
the "RefDes" column.

Some of this works from the macro provided below however not all of it.
- The contents of the "count" column is not correct.
- The macro deletes the duplicate data but then does not resort the data

so
it is full of spaces! I have to rerun the macro to corrct this.
- Sorting the data (reruning the macro) sorts the data via the
"ComponentName" column without headers so the header row is sorted...
ie:
"1","24PIN LCD CONNECTOR","J2","CON_LCD",""
"1","128MEG SDRAM 32X4 ","U2","",""
"Count","ComponentName","RefDes","Value","Descript ion"
"4","SMT CAP 0402 100NF","C12","100nF",""
"","SMT CAP 0402 100NF","C18","100nF",""
"","SMT CAP 0402 100NF","C30","100nF",""
"","SMT CAP 0402 100NF","C33","100nF",""

Now once the data is compared and sorted I have one last step. I would

like
to format the "RefDes" column.
ie: C12, C18, C30, C33 would be for the above data.

Other data might be: C12, C13, C14, C18, C30, C33
This data should be formated C12-C14, C18, C30, C33

The last part might not be possible. The first part is close with the

macro
but needs some tweaking.

Any help on cleaning this up would be appreciated. Thanks.


"mudraker " wrote in message
...
Daniel

For starts try this on a backup copy of your data


I hope I undersand what you are after correctly

Macro assums data is in column A to E with headers
Sorts data by Column B

starting at b2 it checks if data in B3 is the same
if it is then checks if data in C3 is already in B2
if no then adds C3 data to C2 and increase count by 1
then clears row 3 of data
Then repeats checking b2 against c4, c5 etc

if b2 not equal b3 moves on to check b3 against b4 etc



Sub Macro1()
Dim lRow As Long
Dim lStatRow As Long
Dim sTxt As String

'Selection.TextToColumns Destination:=Range("A1"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, _
Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), _
Array(3, 1), Array(4, 1), Array(5, 1))

' Sort Data
Columns("A:E").Sort Key1:=Range("B2"), _
Order1:=xlAscending, Key2:=Range("A2"), _
Order2:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom


lStatRow = 2
For lRow = 2 To Cells(Rows.Count, "b").End(xlUp).Row Step 1
If Cells(lRow, "b").Value < "" Then
If Cells(lStatRow, "A") = 0 Then
Cells(lStatRow, "A") = 1
End If
If Cells(lRow, "b").Value = _
Cells(lStatRow, "b").Value Then
If InStr(1, Cells(lStatRow, "c").Value, _
Cells(lRow, "c").Value) = 0 Then
Cells(lStatRow, "c").Value = _
Cells(lStatRow, "c").Value _
& ", " & Cells(lRow, "c").Value
Cells(lStatRow, "a").Value = _
Cells(lStatRow, "a").Value + 1
Rows(lRow).ClearContents
End If
Else
lStatRow = lRow
End If
end if
Next lRow
End Sub


---
Message posted from http://www.ExcelForum.com/