• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Extracting and Converting Data

B

brightyoyo

New Member
Hi, I am looking for a macro that can convert information form this format:

[pre]
Code: 
C110,C126,C128,C129	                       CAPN/U-0805
C119,C124,C125	                               G40X152K050
C12,C106	                               GRM188R71E474KA
C120	                                       C0805C471K2RAC
C121	                                       GRM21AR72A334KA
C18,C23	                                       GRM31CR71E475KA
C25,C26,C27,C63,C68,C69,C80,C81,C86	       GRM32DR71E106KA
These are reference designators with thier corresponding part number.


To:

C110	CAPN/U-0805
C126	CAPN/U-0805
C128	CAPN/U-0805
C129	CAPN/U-0805
C119	G40X152K050
C124	G40X152K050
C125	G40X152K050
C106	GRM188R71E474KA
C12	GRM188R71E474KA
C120	C0805C471K2RAC
C121	GRM21AR72A334KA
C18	GRM31CR71E475KA
C23	GRM31CR71E475KA
C25	GRM32DR71E106KA
C26	GRM32DR71E106KA
C27	GRM32DR71E106KA
C63	GRM32DR71E106KA
C68	GRM32DR71E106KA
C69	GRM32DR71E106KA
C80	GRM32DR71E106KA
C81	GRM32DR71E106KA
C86	GRM32DR71E106KA
[/pre]
Whereas, I need the individual reference designator with its own part number.


I have attached two files. One has a sample data and the other is a sample results.


https://www.dropbox.com/sh/rhffk9zwqy0b6yw/TP-BfxVSic


Thank You
 
This should help you get started. I can't access you specific file, but should just be tweaking the column references if needed.

[pre]
Code: 
Sub SplitText()

Dim lastRow As Long
Dim xRecord As Long
Dim PartN As String
Dim des As Variant

lastRow = ActiveSheet.Range("A65536").End(xlUp).Row
xRecord = 2

Application.ScreenUpdating = False

'Assumes current data is in col A:B, starting in row 2
For i = 2 To lastRow
PartN = Cells(i, "B").Value
des = Split(Cells(i, "A").Value, ",")
For y = 0 To UBound(des)
'Export to columns C & D
Cells(xRecord, "C").Value = des(y)
Cells(xRecord, "D").Value = PartN
xRecord = xRecord + 1
Next y
Next i

Application.ScreenUpdating = True
End Sub
[/pre]
 
@Luke M

Hi!


Thanks, because, due & regarding your CASFFML severe illness, I'd be as kind as usual and post the first 20 entries in ecah uploaded file.


Data:

-----

[pre]
Code: 
C1,C17					C0603C101J5GACT
C11,C24,C64,C65,C66,C67,C82,C32,C83,	EEF-UE0K101R
C84,C85
C110,C126,C128,C129			CAPN/U-0805
C119,C124,C125				G40X152K050
C12,C106				GRM188R71E474KA
C120					C0805C471K2RAC
C121					GRM21AR72A334KA
C18,C23					GRM31CR71E475KA
C25,C26,C27,C63,C68,C69,C80,C81,C86,	GRM32DR71E106KA
C87,C13,C30,C31,C35
C28,C14,C29,C37,C113,C114,C115,C116	TPSE686K025R01*
C3,C19,C20,C22,C41,C42,C59,C61,C76,	C2012X7R1E105K
C77,C79,C8,C9,C10,C49,C62,C99,C58
C33,C45,C36,C51				GRM32ER71H475KA
C39,C55,C88,C21,C92,C2,C54,C107,C130,	C0603C103K5RACT
C7,C73
C40,C15					C0603C223K3RAC
C43					06031A151KAT2A
-----


Results:

-----

[pre][code]C1	C0603C101J5GACT
C17	C0603C101J5GACT
C11	EEF-UE0K101R
C24	EEF-UE0K101R
C32	EEF-UE0K101R
C64	EEF-UE0K101R
C65	EEF-UE0K101R
C66	EEF-UE0K101R
C67	EEF-UE0K101R
C82	EEF-UE0K101R
C83	EEF-UE0K101R
C84	EEF-UE0K101R
C85	EEF-UE0K101R
C110	CAPN/U-0805
C126	CAPN/U-0805
C128	CAPN/U-0805
C129	CAPN/U-0805
CR1	1N4148W-V
CR12	1N4148W-V
CR2	1N4148W-V
[/pre]
-----


So as you could see things are so pristine and clear (or should I say bright) as brightyoyo told us:

a) entry in A3 of data ends in "C83," and has value in column B

b) entry in A4 ends normally ("C84,C85" without ",") and hasn't a value in column B

c) cells A12 and A13 of results ("C84" & "C85" have the same value in column B as it precedent "C83" in A11: EEF-UE0K101R

d) it happens in more than one row too as in cells A26:B28 with these values:

-----

C60,C71,C78,C89,C34,C70,C93,C94,C97, C0603C104K3RAC
C38,C102,C100,C96,C105,C108,C109,
C117,C118[/code][/pre]
-----


Regards!


EDIT: It seems as if there are continuation lines for long string values in column A that continue in next row without having a new value in column B.


(I forgot posting this clarification)
 
Hi, brightyoyo!

Next please upload seldom 1st worksheets of each workbook in a unique file; it's easier to handle. Thank you.

Regards!
 
Luke that worked. However, is there a way to delete all the initial data and replace it with the the new format.
 
Hi, brighyoyo!


I applied Luke M's code to your sample data file and I got this (1st 50 lines):

-----

[pre]
Code: 
C1	C0603C101J5GACT
C17	C0603C101J5GACT
C11	EEF-UE0K101R
C24	EEF-UE0K101R
C64	EEF-UE0K101R
C65	EEF-UE0K101R
C66	EEF-UE0K101R
C67	EEF-UE0K101R
C82	EEF-UE0K101R
C32	EEF-UE0K101R
C83	EEF-UE0K101R
EEF-UE0K101R
C84
C85
C110	CAPN/U-0805
C126	CAPN/U-0805
C128	CAPN/U-0805
C129	CAPN/U-0805
C119	G40X152K050
C124	G40X152K050
C125	G40X152K050
C12	GRM188R71E474KA
C106	GRM188R71E474KA
C120	C0805C471K2RAC
C121	GRM21AR72A334KA
C18	GRM31CR71E475KA
C23	GRM31CR71E475KA
C25	GRM32DR71E106KA
C26	GRM32DR71E106KA
C27	GRM32DR71E106KA
C63	GRM32DR71E106KA
C68	GRM32DR71E106KA
C69	GRM32DR71E106KA
C80	GRM32DR71E106KA
C81	GRM32DR71E106KA
C86	GRM32DR71E106KA
GRM32DR71E106KA
C87
C13
C30
C31
C35
C28	TPSE686K025R01*
C14	TPSE686K025R01*
C29	TPSE686K025R01*
C37	TPSE686K025R01*
C113	TPSE686K025R01*
C114	TPSE686K025R01*
C115	TPSE686K025R01*
C116	TPSE686K025R01*
-----


So either your actual data differs from your uploaded sample data or you haven't checked it carefully.


Regards!


PS: Here are my two cents for the cause, I updated Luke M's code to your irregular data file (he's a magician, can do marvelous things but's isn't a god yet, he couldn't have foreseen those irregularities):

-----

Sub SplitText()

Dim lastRow As Long
Dim xRecord As Long
Dim PartN As String
Dim des As Variant

lastRow = ActiveSheet.Range("A65536").End(xlUp).Row
xRecord = 2

Application.ScreenUpdating = False

'Assumes current data is in col A:B, starting in row 2
For i = 2 To lastRow
If Cells(i, "B").Value <> "" Then PartN = Cells(i, "B").Value
des = Split(Cells(i, "A").Value, ",")
For y = 0 To UBound(des)
If des(y) <> "" Then
'Export to columns C & D
Cells(xRecord, "C").Value = des(y)
Cells(xRecord, "D").Value = PartN
xRecord = xRecord + 1
End If
Next y
Next i

Application.ScreenUpdating = True
End Sub
[/pre]
-----
 
Hi SirJB7, the spaces were a result of me trying a different approach they are a contuation of the reference designators from the above cell, hence the comma at the end of the last number


the data is this

R6,R30,R40,R50,R52,R53,R13,R25, RMC1/16 10K .1%

R35,R65,R74,R93,R104,R105


but should be this

R6,R30,R40,R50,R52,R53,R13,R25,R35,R65,R74,R93,R104,R105 RMC1/16 10K .1%


Once you have the data in this format, Luke's macro works.
 
Hi, brightyoyo!

That's what my first guess at "So either your actual data differs from your uploaded sample data or you haven't checked it carefully.".

Next time we'd all appreciate your posted files contained the right data, so as to avoid misunderstandings or doing extra work.

Regards
 
@brightyoyo


We could certainly imitate it by just deleting columns A:B when we're done.

Code: 
Range("A:B").Delete

would do the trick if placed at the end of the macro. Generally, I don't like to delete previous data when doing macros just so I have a record of some sort.
 
Hi, brightyoyo!

Glad you discovered it and solved following Luke M code. All credit to him. Thanks for your feedback and welcome back whenever needed or wanted.

Regards!
 
Hello, another question. Can that macro form Luke M include a way to open the new data in a new excel file with the same name as the first except with _prn at the end of it.


Example: Origanl Name PL706485-02

New Name PL706485-02_prn
 
Hi brightyoyo.

Sure thing. We'll just add in a few lines to create and save the new book.

[pre]
Code: 
Sub SplitText()

Dim lastRow As Long
Dim xRecord As Long
Dim PartN As String
Dim des As Variant
Dim newBook As Workbook
Dim newSheet As Worksheet

lastRow = ActiveSheet.Range("A65536").End(xlUp).Row
xRecord = 2

Application.ScreenUpdating = False

'Create new workbook in same folder as current file
Application.Workbooks.Add
ActiveWorkbook.SaveAs WorksheetFunction.Substitute(ThisWorkbook.FullName, ".xls", "_prn.xls")
Set newBook = ActiveWorkbook
Set newSheet = ActiveSheet

'Assumes current data is in col A:B, starting in row 2
For i = 2 To lastRow
ThisWorkbook.Activate
If Cells(i, "B").Value <> "" Then PartN = Cells(i, "B").Value
des = Split(Cells(i, "A").Value, ",")
newBook.Activate
For y = 0 To UBound(des)
If des(y) <> "" Then
'Export to columns A & B of new book
newSheet.Cells(xRecord, "A").Value = des(y)
newSheet.Cells(xRecord, "B").Value = PartN
xRecord = xRecord + 1
End If
Next y
Next i

'Save the new workbook?
newBook.Save
Application.ScreenUpdating = True
End Sub
[/pre]
 
Hi Luke M After some though I think it would be better if the macro just opened another worksheet, not another workbook. Could you help me out?
 
Hi, brightyoyo!


Since Luke M won't come back today I modified the last version of the code to work as you now requested. Test it carefully, here's the code:

-----

[pre]
Code: 
Option Explicit

Sub SplitTextInSameWorkbook()

Dim lastRow As Long
Dim xRecord As Long
Dim PartN As String
Dim des As Variant
Dim oldSheet As Worksheet, newSheet As Worksheet
Dim I As Long, Y As Long

lastRow = ActiveSheet.Range("A65536").End(xlUp).Row
xRecord = 2

Application.ScreenUpdating = False

'Create new worksheet in active workbook
Set oldSheet = ActiveSheet
Application.ThisWorkbook.Worksheets.Add
Set newSheet = ActiveSheet

'Assumes current data is in col A:B, starting in row 2
With oldSheet
For I = 2 To lastRow
.Activate
If .Cells(I, "B").Value <> "" Then PartN = .Cells(I, "B").Value
des = Split(.Cells(I, "A").Value, ",")
newSheet.Activate
For Y = 0 To UBound(des)
If des(Y) <> "" Then
'Export to columns A & B of new book
newSheet.Cells(xRecord, "A").Value = des(Y)
newSheet.Cells(xRecord, "B").Value = PartN
xRecord = xRecord + 1
End If
Next Y
Next I
End With

'Save active workbook?
ThisWorkbook.Save
Application.ScreenUpdating = True
End Sub
[/pre]
-----


Regards!


@Luke M

Hi!

Hope you don't mind I've fixed the code. I do mind to must have done it :)

Regards!
 
Hi, brightyoyo!

Glad you solved it. Thanks for your feedback but all credit is for Luke M. welcome back whenever needed or wanted.

Regards!

PS: Now you have an example of a two sheet workbook, so next time... :)
 
You must log in or register to reply here.
Back
Top