Removing unwanted characters VBA (excel) - regex

Question

I want to be able to copy raw data into column A, hit run on the macro and it should remove any unwanted characters both before and after the data that I want to keep resulting in a cell just containing the data that I want. I also want it to go through all cells that are in the column, bearing in mind some cells may be empty.
The data that I want to keep is in this format: somedata0000 or somedata000
Sometimes the cell will contain 'rubbish' both before and after the data that I want to keep i.e. rubbishsomedata0000 or somedata0000rubbish or rubbishsomedata0000rubbish.
And also, sometimes a single cell will contain:
rubbishsomedata0000rubbish
rubbishsomedata0000rubbish
rubbishsomedata0000rubbish
This will need to be changed to:
NEW CELL: somedata0000
NEW CELL: somedata0000
NEW CELL: somedata0000
The 'somedata' text will not change but the 0000 (which could be any 4 numbers) will sometimes be any 3 numbers.
Also there may be some rows in the column that have no useful data; these should be removed/deleted from the sheet.
Finally, some cells will contain the perfect somedata0000, these should stay the same.
Sub Test()
Dim c As Range
For Each c In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
c = removeData(c.text)
Next
End Sub
Function removeData(ByVal txt As String) As String
Dim result As String
Dim allMatches As Object
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
RE.Pattern = "(somedata-\d{4}|\d{3})"
RE.Global = True
RE.IgnoreCase = True
Set allMatches = RE.Execute(text)
If allMatches.Count <> 0 Then
result = allMatches.Item(0).submatches.Item(0)
End If
ExtractSDI = result
End Function
I have put my code that I've got so far, all it does is go through each cell, if it matches it just removes the text that I want to keep as well as the stuff that I want removed! Why?

Answer 1

There are several issues in your code
As Gary said, you Function isn't returning a result
Your Regex.Pattern doesn't make sense
Your Sub doesn't attempt to handle multiple matches
Your Function doesn't even attempt to return multiple matches
Sub Test()
Dim rng As Range
Dim result As Variant
Dim i As Long
With ActiveSheet
Set rng = Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
For i = rng.Rows.Count To 1 Step -1
result = removeData(rng.Cells(i, 1))
If IsArray(result) Then
If UBound(result) = 1 Then
rng.Cells(i, 1) = result(1)
Else
rng.Cells(i, 1).Offset(1, 0).Resize(UBound(result) - 1, 1).Insert xlShiftDown
rng.Cells(i, 1).Resize(UBound(result), 1) = Application.Transpose(result)
End If
Else
rng.Cells(i, 1).ClearContents
End If
Next
End Sub
Function removeData(ByVal txt As String) As Variant
Dim result As Variant
Dim allMatches As Object
Dim RE As Object
Dim i As Long
Set RE = CreateObject("vbscript.regexp")
RE.Pattern = "(somedata\d{3,4})"
RE.Global = True
RE.IgnoreCase = True
Set allMatches = RE.Execute(txt)
If allMatches.Count > 0 Then
ReDim result(1 To allMatches.Count)
For i = 0 To allMatches.Count - 1
result(i + 1) = allMatches.Item(i).Value
Next
End If
removeData = result
End Function