search cells for unique part and paste in new column -- difficult VB

[Kellens]

Hello, i am new to the boards and am struggeling with some macro i would to use.
I've looked for some examples but cannot find what i would need.

The current table is as follows:
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]ID[/TD]
[TD]Column header[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]recorded power 2200W[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]diameter 8 mm[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]lenght 15 mm[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]lenght 5 mm[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]lenght 10 mm[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]recorded power 5000W[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]recorded power 2500W[/TD]
[/TR]
</tbody>[/TABLE]

Now ideally i would like to have the following result

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]ID
[/TD]
[TD]Recorded power[/TD]
[TD]Diameter[/TD]
[TD]lenght[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]2200W[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD][/TD]
[TD]8 mm[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD][/TD]
[TD][/TD]
[TD]15 mm[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD][/TD]
[TD][/TD]
[TD]5 mm[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD][/TD]
[TD][/TD]
[TD]10 mm[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]5000W[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]2500W[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

So i was thinking that the part before a number would become the header and the number and everything behind it would become the value that is pasted in the corresponding column.

Would something like this would be possible?

 

[Kellens]

if this is too hard to do in VB code it would also be ok if i would get the entire contents in a cell so the result would be:

ID
1 Recorded power 2200W
2 diameter 8 mm
3 lenght 15mm
4 lenght 5 mm
5 lenght 10mm
6 Recorded power 5000W
7 Recorded power 2500W

 

[hiker95]

Kellens,

Welcome to the MrExcel forum.

1. What version of Excel and Windows are you using?

2. Are you using a PC or a Mac?


Sample raw data:

Excel 2007
	A	B	C	D	E	F	G	H
1	ID	Column header
2	1	recorded power 2200W
3	2	diameter 8 mm
4	3	lenght 15 mm
5	4	lenght 5 mm
6	5	lenght 10 mm
7	6	recorded power 5000W
8	7	recorded power 2500W
9
Sheet1

After the macro using two arrays in memory:

Excel 2007
	A	B	C	D	E	F	G	H
1	ID	Column header			ID	Recorded Power	Diameter	Lenght
2	1	recorded power 2200W			1	2200W
3	2	diameter 8 mm			2		8 mm
4	3	lenght 15 mm			3			15 mm
5	4	lenght 5 mm			4			5 mm
6	5	lenght 10 mm			5			10 mm
7	6	recorded power 5000W			6	5000W
8	7	recorded power 2500W			7	2500W
9
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub ReorgData()
' hiker95, 08/21/2014, ME800435
Dim a As Variant, o As Variant
Dim i As Long, j As Long, lr As Long
Application.ScreenUpdating = False
Columns("E:H").ClearContents
lr = Cells(Rows.Count, 1).End(xlUp).Row
a = Range("A1:B" & lr)
ReDim o(1 To lr, 1 To 4)
j = j + 1
o(j, 1) = "ID"
o(j, 2) = "Recorded Power"
o(j, 3) = "Diameter"
o(j, 4) = "Lenght"
For i = 2 To lr
  If InStr(a(i, 2), "recorded") Then
    o(i, 1) = a(i, 1)
    o(i, 2) = Right(a(i, 2), Len(a(i, 2)) - 15)
  ElseIf InStr(a(i, 2), "diameter") Then
    o(i, 1) = a(i, 1)
    o(i, 3) = Right(a(i, 2), Len(a(i, 2)) - 8)
  ElseIf InStr(a(i, 2), "lenght") Then
    o(i, 1) = a(i, 1)
    o(i, 4) = Right(a(i, 2), Len(a(i, 2)) - 7)
  End If
Next i
Range("E1:H" & lr) = o
Columns("E:H").AutoFit
Application.ScreenUpdating = False
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ReorgData macro.

 

[Snakehips]

Kellens,

***Edit I see Hiker has given you a response which I'm sure will work for your posted data.
Hopefully the below will work with any text in B and automatically populate new headers as required??

Attempting your first request.
Assuming that your ID is in column A and detail in B, row 2 is first row of data and that columns to the right are empty then try this code.
Right click sheet tab >> View Code >> Paste

Sub Kellens()


Application.ScreenUpdating = False
LR = Cells(Rows.Count, 1).End(xlUp).Row
lc = 3
For Each cell In Range("B2:B" & LR)


For i = 1 To Len(cell)
If Val(Mid$(cell, i)) > 0 Then
Ln = Mid$(cell, i)
Exit For
End If
Next i


Head = StrConv(Trim(Left(cell, i)), vbProperCase)
On Error Resume Next
Hcol = WorksheetFunction.Match(Head, Rows(1), 0)
On Error GoTo 0
If Hcol = 0 Then
Hcol = lc
Cells(1, lc) = Head
End If
cell.Offset(0, Hcol - 2) = Trim(Right(cell, Len(cell) - i))
lc = lc + 1
Hcol = 0
Next cell
End Sub

You can then delete column B if that is what you want.

Hope that helps.

 

[Kellens]

thanks a lot for the replies...
The first piece of code from Hiker95 seems to solve it but since i have so many variables in column B i would have to list them all in the document.

The code from snakehips looks like it does this automatically but i am getting an error (Run-time error '5': Invalid procedure call or argument)in this line

cell.Offset(0, Hcol - 2) = Trim(Right(cell, Len(cell) - i))

To answer your question i am using a pc with Excel 2007

 

[Snakehips]

That would suggest to me that you have either some blanks in B or some text that does not have the number character that you said would indicate the separation point.

Can you tell me if it is just missing number or also possibility of blanks.
In terms of header and info, how will you want to handle such rows?

 

[Kellens]

Hello Snakehips,

There is both a possibility of blancs and the possibility of missing numer in a cell contents.
If there is a blanc the row can be skipped if there is a missing number it can be pasted in the header and the same content in the correspônding row (i think that will be easiest)

IF for instance the word "test" is present in the first and fourth row the result will then be:

[B]id    test[/B]
1     test
2
3     
4     test

Thanks a lot for your help so far

 

[Kellens]

When there aren't numbers in the phrase it is possible that there are multiple words separated by a space. Duno if that is relevant for your code... I am mentioning it just in case
If your code works it would save me sooooo much work **** fingers crossed *****

 

[hiker95]

Kellens,

Have you even tried my macro solution?

If the raw data, and, results, that you posted in your original thread, reply #1, is not correct, can we have two more screenshots of some actual real data?

 

[Kellens]

Hello Snakehips

I have just tried the code and it works like a charm - exactly what i needed (as long as there aren't blancs or missing numbers).
The only downside is that the code generates empty columns in between the columns that are filled with data. If there are 4 results there are also 4 empty rows...