• 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.

Filter and copy data from one column to two

JBrauny

New Member
I currently have a line header and associated numbers exported into excel in the same column.


The following example is currently in one column. I need to separate and expand these into two columns.

Example:


LINE ABC

3030C

10026A

10026B

10026C

LINE ABH

7595

7644

11146

16837

16838

8150009C

8150064C


Needs to look like following in two columns:


ABC 3030C

ABC 10026A

ABC 10026B

ABC 10026C

ABH 7595

ABH 7644

ABH 11146

ABH 16837

ABH 16838

ABH 8150009C

ABH 8150064C


Thoughts?


jay
 
Hi Jay ,


A VBA procedure will be simple compared to a formula solution. Is this OK with you ?


Secondly , you have shown the word LINE as the header ; will this word actually appear or have you shown it just to give us the idea ? In the procedure , can this word be used to determine a header , so that entries after this will all appear in a second column , till we come across another LINE ?


Narayan
 
Narayan-


Whatever is simple is OK with me. I will learn VBA sometime; better with guidance than on my own.


Yes - the data shown is as it is exported; LINE appears as I have it and the following digits (ABC or ABH in this case) will always be 3. There is a possibility of LINE LIN to which I have some numbers associated with, but just a handful.


Currently the data comes formatted as text but I multiply the column by 1 to get it to a number. I am open to how I clean the data right now because I am on the front end of this project.


jay
 
Hi ,


Try this and see if it works :

[pre]
Code:
Public Sub Temp()
Const HEADER_TEXT = "LINE"

Set s2 = ThisWorkbook.Sheets("Sheet2")
s2.Activate
Range("A1").Select

Set s1 = ThisWorkbook.Sheets("Sheet1")
s1.Activate
Range("A5:A17").Select

offset_count = 0

For Each text_item In Selection
left_part = Left(text_item, 4)
If left_part = HEADER_TEXT Then
s2.Activate
current_header = Right(text_item, 3)
ActiveCell.Offset(offset_count, 0).Value = current_header
Else
s2.Activate
ActiveCell.Offset(offset_count, 0).Value = current_header
ActiveCell.Offset(offset_count, 1).Value = text_item
offset_count = offset_count + 1
End If
s1.Activate
Next

End Sub
[/pre]

Narayan
 
Hi JBrauny,


This won't give exactly what you want, but it will split it into 2 columns as desired


Paste your data starting in A2


Put this into B2

=IF(LEFT(A2,4)="LINE",TRIM(RIGHT(A2,LEN(A2)-4)),B1)


And this into C2

=IF(LEFT(A2,4)="LINE","",A2)


which will give this


ABC

ABC 3030C

ABC 10026A

ABC 10026B

ABC 10026C

ABH

ABH 7595

ABH 7644

ABH 11146

ABH 16837

ABH 16838

ABH 8150009C

ABH 8150064C


The rows with LINE will have a blank. You could combine this with a little VBA that:

- inserts the formulas

- copy paste/special values

- filters down on the blanks

- deletes those visible rows

- unfilters
 
Hi Jay ,


Sorry to know that you had problems ; I can only imagine that certain changes which needed to be made at your end were not made. The following section of code needs to be changed to suit the names and data ranges in your worksheet ; did you make these changes ?


Set s2 = ThisWorkbook.Sheets("Sheet2")

s2.Activate

Range("A1").Select


Set s1 = ThisWorkbook.Sheets("Sheet1")

s1.Activate

Range("A5:A17").Select


Sheet1 , Sheet2 are tabs which need to be changed depending on the tabs in which you have data in your workbook.


The range A5:A17 is the one where I copied and pasted the sample data you had posted ; you need to change this line to reflect your actual data range.


A1 is the starting cell from where the data will be put the way you want it to be formatted ; change this if required.


The entire code has to be copied into the ThisWorkBook section in VBA Explorer.


Narayan
 
Narayan - Thank you for the follow up explanation. I changed the range and it worked like a charm.


I would like to expand on what I just learned. With the orig data in column A, how could I have subsequent data in additional columns follow our expansion that the macro performs?


I'm assuming having the macro move the data is the most efficient way. If there is easier, please recommend.


Example:

Column A ColumnB ColumnC


LINE ABC

3030C 5 4.9

10026A 4 5.4

10026B 2 4.8

10026C 7 7.8

LINE ABH

7595 2 5.5

7644 2 1.1

11146 3 4.1

16837 2 4.6

16838 3 3.2

8150009C 1 2.2

8150064C 2 2.1


to


ABC 3030C 5 4.9

ABC 10026A 4 5.4

ABC 10026B 2 4.8

ABC 10026C 7 7.8

ABH 7595 2 5.5

ABH 7644 2 1.1

ABH 11146 3 4.1

ABH 16837 2 4.6

ABH 16838 3 3.2

ABH 8150009C 1 2.2

ABH 8150064C 2 2.1


I am new to VBA, please be patient with my questions. It's like learning excel functions all over again and I'm sure answers are right in front of me.


jay
 
Kyle - Thanks for the viewpoint. I follow your thoughts and it worked well in a test worksheet. My actual sheets are up to 30K + rows which I am trying to automate.


As I learn VBA more, I may just try to record a macro that uses it. Regardless, I've never used TRIM, etc.


Thanks to you and Narayan for teaching me.!


Jay
 
Narayan - I just noticed that I had Column A, B, and C spaced out as I typed my reply above, but it was condensed down when it posted.


jay
 
Hi Jay ,


Nice to know you are on the VBA road ; may your journey take you to interesting places !


If you need to expand your data columns , the modified code is shown below :

[pre]
Code:
Public Sub Temp()
Const HEADER_TEXT = "LINE"
Const SPACE = " "

Set s2 = ThisWorkbook.Sheets("Sheet2")
s2.Activate
Range("A1").Select

Set s1 = ThisWorkbook.Sheets("Sheet1")
s1.Activate
Range("A5:A17").Select

offset_count = 0

For Each text_item In Selection
left_part = Left(text_item, 4)
If left_part = HEADER_TEXT Then
s2.Activate
current_header = Right(text_item, 3)
ActiveCell.Offset(offset_count, 0).Value = current_header
Else
s2.Activate
ActiveCell.Offset(offset_count, 0).Value = current_header
'..........Process the several items in the same cell............
current_string = text_item
len_string = Len(current_string)
current_item = ""
item_count = 1
char_count = 1
Do
current_char = Mid(current_string, char_count, 1)
If (current_char <> SPACE) Then
current_item = current_item + current_char
End If

If ((current_char = SPACE) Or (char_count = len_string)) Then
ActiveCell.Offset(offset_count, item_count).Value = current_item
current_item = ""
item_count = item_count + 1
End If
char_count = char_count + 1
Loop Until char_count > len_string
'..........End of Processing several items in the same cell............
offset_count = offset_count + 1
End If
s1.Activate
Next

End Sub
[/pre]

Narayan
 
Narayan - Thank you!!


As I read the code, I'm seeing "items in the same cell."


So is this assumption that "3030C 5 4.9" is all in one cell.? My intent was to show that 3030C, 5, & 4.9 are in individual columns.


jay
 
Hi Jay ,


Sorry , my mistake. Then the changes to the first code are far simpler. I'll post them after some time.


Narayan
 
Hi Jay ,


The revised code is as under ; I am sure you can see the changes which have been made , and add to them if you need more columns to be formatted.

[pre]
Code:
Public Sub Temp()
Const HEADER_TEXT = "LINE"

Set s2 = ThisWorkbook.Sheets("Sheet2")
s2.Activate
Range("A1").Select

Set s1 = ThisWorkbook.Sheets("Sheet1")
s1.Activate
Range("A5:A17").Select

offset_count = 0

For Each text_item In Selection
left_part = Left(text_item, 4)
If left_part = HEADER_TEXT Then
current_header = Right(text_item, 3)
Else
s2.Activate
ActiveCell.Offset(offset_count, 0).Value = current_header
ActiveCell.Offset(offset_count, 1).Value = text_item
ActiveCell.Offset(offset_count, 2).Value = s1.Range(text_item.Address).Offset(0, 1).Value
ActiveCell.Offset(offset_count, 3).Value = s1.Range(text_item.Address).Offset(0, 2).Value
offset_count = offset_count + 1
End If
s1.Activate
Next

End Sub
[/pre]

Narayan
 
Narayan -


Yes I see the differences. I will let all this sink in today and play with it this weekend.


Thanks for the help.


jay
 
Back
Top