VBA: Extracting multiple strings from cells onto multiple columns.

JMudd

New Member
Joined
Jul 8, 2019
Messages
3
Greetings,



Long time lurker, first time poster. I'm not sure if this is possible in VBA (I searched but didn't find anything close to my situation), but I have a spreadsheet containing invoice information in column A. In each cell, there are PKS numbers, which I'm trying to extract onto the columns directly to the right. Some cells contain multiple PKS numbers, which is why I'm not sure how this could be done.






This is the final result I'm trying to achieve.






-JM
 

hiker95

Well-known Member
Joined
Apr 8, 2009
Messages
17,647
JMudd,

Welcome to the MrExcel forum.

We can not tell what worksheet(s), cells, rows, columns, your raw data is in.

And, we can not tell what the results should look like.

Can you post a screen shot of what your data looks like?

Section B at this link has instructions on how to post a screen shot: https://www.mrexcel.com/forum/board-...forum-use.html


Alternately, you could upload a copy of your file to a free site such as www.box.com. or www.dropbox.com.

Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here.

Include a detailed explanation of what you would like to do referring to specific cells, rows, columns and worksheets.

If the workbook contains confidential information, you could replace it with generic data.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
30,132
Office Version
365
Platform
Windows
How about
Code:
Sub JMudd()
   Dim Cl As Range
   Dim Sp As Variant
   Dim i As Long, j As Long
   
   For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
      Sp = Split(Cl, Chr(10))
      For i = 0 To UBound(Sp)
         If InStr(1, Sp(i), "PKS", vbTextCompare) > 0 Then
            j = j + 1
            Cl.Offset(, j).Value = Split(Sp(i))(0)
         End If
      Next i
      j = 0
   Next Cl
End Sub
 

JMudd

New Member
Joined
Jul 8, 2019
Messages
3
How about
Code:
Sub JMudd()
   Dim Cl As Range
   Dim Sp As Variant
   Dim i As Long, j As Long
   
   For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
      Sp = Split(Cl, Chr(10))
      For i = 0 To UBound(Sp)
         If InStr(1, Sp(i), "PKS", vbTextCompare) > 0 Then
            j = j + 1
            Cl.Offset(, j).Value = Split(Sp(i))(0)
         End If
      Next i
      j = 0
   Next Cl
End Sub
This works perfectly!!! Thank you so much Fluff!!!

-JM
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
30,132
Office Version
365
Platform
Windows
You're welcome & thanks for the feedback
 

Forum statistics

Threads
1,077,666
Messages
5,335,575
Members
399,026
Latest member
Im_Stupid

Some videos you may like

This Week's Hot Topics

Top