VBA: Extracting multiple strings from cells onto multiple columns.

JMudd

New Member
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
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
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
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
 

Some videos you may like

This Week's Hot Topics

  • Importing multiple excel files into one spreadsheet
    Hi, I'm trying to import multiple excel files (with the same format into a single spreadsheet) so that each day's file is listed underneath the...
  • find many based on a certain criteria
    good evening, I hope someone can help me? I have a workbook sheet 2 contains lots of data.... I would like to be able to find anything on sheet...
  • How to copy multiple rows using If
    Hi all, I'm very new to VBA and have written this simple code to copy certain cells if a certain cell within that row contains any data. I need...
  • VBA If statement
    Dear All, I have two dates, where I'd like a message box to pop, if the dates are between this criteria. [CODE] sDate1 = #10/1/2019#...
  • Text Format
    I have a sheet for user to keyin the data. The format of the data can be 451 / 1903, 0012 / 9908 or 00287 / 0099. The number after the "/" is...
  • Macro to copy values across rows and transposing them and add the user id
    [FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]Hi,[/COLOR][/SIZE][/FONT] [FONT=Times New...
Top