I am trying to isolate the address changes I have gotten from a folder containing a series of files with names containing the address changes. See the first image I included as an example of the folder I am drawing from. I iterate through the folder and output the to an excel sheet the original address and the new address to excel. The issue I am encountering is that not all file names are the same so I currently cannot draw the correct address change information from the filenames. The second photo included is a photo of the output, the files in yellow are the filenames that my script cannot iterate for. If anyone has any suggests on how to broaden the number of cases I can deal with it would be very helpful see current code below.
Dim AddChng As Worksheet
If sheetExists("AddressChange") Then 'create a new sheet if one doesn't exist
Set AddChng = ThisWorkbook.Sheets("AddressChange")
Else
Set AddChng = ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count))
AddChng.Name = "AddressChange"
End If
AddChng.UsedRange.Delete shift:=xlUp 'clear the sheet
AddChng.Range("A1").Value = "Old Name" 'set up
AddChng.Range("B1").Value = "New Name"
AddChng.Activate
AddChng.Range("A2").Select
Dim StrFile As String
'Change this to the directory containing all Address Change Circulation emails
'This will Pull in a list and, to the best of its ability make two columns that hold the data for
'the old and the new address
StrFile = Dir(Range("AddressChangeFolderPath").Value)
Dim Names() As String
Dim StrName
Do While Len(StrFile) > 0
CheckVal = InStr(1, StrFile, "Address Change Circulation -", vbTextCompare) + _
InStr(1, StrFile, "Address Change Circulation from ", vbTextCompare)
If CheckVal <> 1 Then 'if the email does not fit the standard, just place it in the cell and
'move on to the next entry
Selection.Value = StrFile
Selection.Interior.Color = RGB(255, 255, 0) 'highlight the cell
Selection.Offset(1, 0).Select
Else
StrName = Right(StrFile, Len(StrFile) - 29) 'trim to the correct size - probably not the
'best way to do this but it works
If Left(StrName, 4) = "from" Then
StrName = Right(StrName, Len(StrName) - 5)
ElseIf Left(StrName, 2) = "om" Then
StrName = Right(StrName, Len(StrName) - 3)
End If
StrName = Left(StrName, Len(StrName) - 4)
Changes = Split(StrName, " and ")
For Each Change In Changes
Names = Split(Change, " to ")
If Len(Names(0)) < 5 Then
Selection.Value = Names(0) & Right(Names(1), Len(Names(1)) - Len(Names(0)))
Else
Selection.Value = Names(0)
End If
If UBound(Names) >= 1 Then 'this is a zero indexed array, checking greater than or
'equal to 1 will check if there are two or more entries
Selection.Offset(0, 1).Value = Names(1) ' in the event that there is no " to " in
'the file name and it hasn't been handeled already
End If
Selection.Offset(1, 0).Select 'select the next cell to accept the next entry
Next
End If
StrFile = Dir
Loop
MsgBox "Make sure to QAQC the new table and update any fields that haven't been properly " & _
"filled in by the automation."
End Sub

