Macro to find correct data in a cells that have multiple values.

Script Example.png (Picture)
Script Example.xlsx (Example Workbook)

I'm trying to wrap my head around this and I'm not sure what the easiest way out be.. or if it's even possible (I've found pretty much anything is possible with Excel though..)

I have a report that I pull that I pull fairly often that is in this format and shows which footage of products each store is getting (out of over 1800 stores)!
Above is the format that it comes back as. And here is a spreadsheet that shows what steps I take to find correct values in detail.

So each FTG has an ID# and Desc. The ID is in text format and each ID is seperated with a comma, no space. Description also. Date is seperate by a space and comma. Stores change footages a lot so I want to find out which footage is effective today (1/27/2014) For ex: Store 63 would have the 5ft effective right now because we are between 5/23/08 and 5/22/14. So each ID# and Ftg Description is in the same order as Date.

When I have hundreds of stores, it is difficult to go through and get each one (even with the way I've been doing it.) But my ultimate goal is to create a macro to put only the current footage ID#, Desc, and Date in Columns C,D,and E. I'm not sure even where to start with doing a macro.

I usually just find the store with most ftgs, count them, insert that many rows after ID and Description columns, then do a text to columns (comma, delimited), sort by 2nd date column (so they all come up top) and then manually go through them and delete unneeded columns once I have them all. There has to be a better way...

Thank you in advance for any help!

Paul

Hey Perm,

Attach a sample workbook and we'll try to help you.

This will blow up C,D and E for you but you cant have just FT in the description:

Sub Perm(): Dim ws As Worksheet, c As Integer
Dim R As Range, i As Long, j As Long, lr As Long, R1, R2
Set ws = Sheets("Original Rpt")
lr = ws.Range("C" & Rows.count).End(xlUp).row: i = 2
Do Until i > lr: Set R = Range("C" & i): c = Len(R) Mod 3
If c Then
For j = 1 To c: R.EntireRow.Copy
ws.Cells(i + j, 1).EntireRow.Insert: Next j
        R = Replace(R, ",", "")
        R1 = Replace(R.Offset(0, 1), ",", "")
        R2 = Replace(R.Offset(0, 2), ",", "")
For j = c To 1 Step -1
R.Offset(j, 0) = Right(R, 3): R = Left(R, Len(R) - 3)
R.Offset(j, 1) = Right(R1, 7): R1 = Trim(Left(R1, Len(R1) - 7))
                R.Offset(j, 2) = Right(R2, 10)
If Len(R2) > 10 Then R2 = Trim(Left(R2, Len(R2) - 10))

If j = 1 Then
R.Offset(0, 1) = R1: R.Offset(0, 2) = R2
End If
Next j
End If: i = i + c + 1: lr = lr + c: Loop
Application.CutCopyMode = False
End Sub

Copy the code to the clipboard
Press ALT + F11 to open the Visual Basic Editor.
Select Module from the Insert menu
Type "Option Explicit" then paste the code into the white space on the right.

With the cursor between Sub and End Sub press F5 OR

Press ALT + Q to close the code window.
Press ALT + F8 then double click on the macroname (Perm)

Nevermind...