I have a worksheet (Sheet1) that contains about 10,000 cells in ColumnD full of textual data
Each Cell in Column D (From D2) contains lot of text with some special charecters in it and out of that i want to pull out a pattern like this ####-### where each # is a digit.
This pattern does not appear at a set place in each cell and there are multiple entries of this in each cell.
My requirement is to pull out a pattern and put it in Column E (If it is only 1 entry as per the pattern)
If there are multiple entries of the same pattern (the return value should be placed in the same row and subsequent columnns)
If it is a single entry i can use this formula but i have multiple entried in one cell. So i am using the below code but it is not working. Not sure what wrong i am doing.
Sub ExtractPattern() On Error Resume Next Set SourceSheet = ActiveSheet Set TargetSheet = ActiveWorkbook.Sheets("Results") If Err = 0 Then Worksheets("Results").Delete End If Worksheets.Add ActiveSheet.Name = "Results" Set TargetSheet = ActiveSheet Cells(1, 1).Value = "Found Codes" Cells(1, 1).Font.Bold = True iTargetRow = 2 SourceSheet.Select Selection.SpecialCells(xlCellTypeLastCell).Select Range(Selection, Cells(1)).Select For Each c In Selection.Cells If c.Value Like "*####-###*" Then sRaw = c.Value iPos = InStr(sRaw, "-") Do While iPos > 0 If iPos < 4 Then sRaw = " " & sRaw iPos = iPos + 4 End If sTemp = Mid(sRaw, iPos - 4, 8) sRaw = Mid(sRaw, iPos + 6, Len(sRaw)) If sTemp Like "##-#####" Then TargetSheet.Cells(iTargetRow, 1) = sTemp iTargetRow = iTargetRow + 1 Else sRaw = Mid(sTemp, 4, 5) & sRaw End If iPos = InStr(sRaw, "-") Loop End If Next c End Sub
D2 - MS09-062
It should Return (MS06-030 in E3, MS08-068 in F3)
It should Return (MS09-037 in E4, MS08-048 in F4)
MS08-033, MS09-028, and MS09-047
MS08-055, MS09-017, MS10-017, MS10-004, MS10-023, MS10-028, MS09-068, and MS09-027
It should Return (MS08-055 in E6, MS10-017 in F6, MS10-023 in G6,...........)