This was actually a lot of fun and I am pretty happy with the result.
Copy and paste this code into a module and then run it. Remember that all VBA code cannot be undone so be sure to save your workbook and have a backup before running.
this code is written with the headers being on row 2. If this needs to change you can change the value of the HeaderRow where it says 'Set the references
Code:
Option Explicit
Sub ParsePropertyData()
'Takes each value in column A and manipulates the string to contain
'the proper delimiters. Cleans the string up of extra spaces and
'goes through the headers and stores them in an array to search out
Dim CheckString As String, NewString As String, Col As Integer
Dim CheckRow As Integer, x As Integer, v As Variant, ParseString As String
Dim Header() As String, LastRow As Integer, LastCol As Integer
Dim HeaderRow As Integer, StartChar As Integer, EndChar As Integer
'Set the references
HeaderRow = 2
LastCol = Range("A" & HeaderRow).End(xlToRight).Column
LastRow = Range("A" & HeaderRow).End(xlDown).Row
'Set the headers in an array
ReDim Header(2 To LastCol) As String
For x = 2 To LastCol
Header(x) = Cells(HeaderRow, x).Value
Next x
'Format and parse each data row
For CheckRow = HeaderRow + 1 To LastRow
CheckString = Range("A" & CheckRow).Value
'Format the string
CheckString = Replace(CheckString, ": ", ":")
For Each v In Header
If InStr(1, CheckString, v) Then
CheckString = Replace(CheckString, v, ";" & v)
End If
Next v
'Remove the first semi-colon
If Left(CheckString, 1) = ";" Then
CheckString = Mid(CheckString, 2)
End If
'Convert to a new string to check
NewString = WorksheetFunction.Trim(CheckString)
'Parse the data
For Col = 2 To LastCol
If InStr(1, NewString, Header(Col) & ":") Then
StartChar = InStr(1, NewString, Header(Col) & ":")
EndChar = InStr(StartChar, NewString, ";") - 1
If EndChar <> -1 Then
ParseString = Mid(NewString, StartChar, EndChar - StartChar)
Else
ParseString = Mid(NewString, StartChar)
End If
'Put the result in the cell
Cells(CheckRow, Col).Value = Mid(ParseString, InStr(1, ParseString, ":") + 1)
End If
Next Col
Next CheckRow
End Sub
I tested this on your sample and it appears to work 100%
a couple of notes though.
On your attachment you have 2 headers that will need to be changed for this to work and continue to work in the future.
Column B said Rent Price: Needs to be Rent Price (no colon)
Column M said Property should be Property age
Let me know how it works out or if you have any other questions.
Thanks