A further problem that I am struggling with

[Its me]

I have a 800 row of data in each 8th row there is the same information.
The information shows the name of the business and the proprietor
The proprietor title is ALWAYS Mr. Mrs. or Miss

JOHNS FRUIT SHOP MR JOHN BROWN

MARYS CAKE SHOP MISS MARY SMITH

What I want to is break the info into two fields, breaking it on the title
Mr Mrs or Miss and (if it is possible) insert the name data into the next
row

So originally it will be:

Row 81 JOHNS FRUIT SHOP MR JOHN BROWN

and it will then appear as:

Row 81 JOHNS FRUIT SHOP
Row 82 MR JOHN BROWN

One problem that may appear is as soon as the macro spilt my original data
cluster of 8 rows it will then become 9 rows

A possible solution may be 2 macros, one to split the data into another Col.
(B) and then a second macro to reinsert it into row 9 with a progressive +1

A big ask for a Sunday morning!

Regards
Stephen
Gold Coast, Australia

 

[Ron Rosenfeld]

I have a 800 row of data in each 8th row there is the same information.
The information shows the name of the business and the proprietor
The proprietor title is ALWAYS Mr. Mrs. or Miss

JOHNS FRUIT SHOP MR JOHN BROWN

MARYS CAKE SHOP MISS MARY SMITH

What I want to is break the info into two fields, breaking it on the title
Mr Mrs or Miss and (if it is possible) insert the name data into the next
row

So originally it will be:

Row 81 JOHNS FRUIT SHOP MR JOHN BROWN

and it will then appear as:

Row 81 JOHNS FRUIT SHOP
Row 82 MR JOHN BROWN

One problem that may appear is as soon as the macro spilt my original data
cluster of 8 rows it will then become 9 rows

A possible solution may be 2 macros, one to split the data into another Col.
(B) and then a second macro to reinsert it into row 9 with a progressive +1

A big ask for a Sunday morning!

Regards
Stephen
Gold Coast, Australia

Not too tough but your description is inconsistent.

In your request, you write:

"The proprietor title is ALWAYS Mr. Mrs. or Miss"

But in your data sample, you show " MR " or " MISS " (all caps, no ".", and a
space before and after the title).

I assumed that
the title could be upper or lower case
the title did NOT have the "." after
the title was always surrounded by <space>'s
the title was the first word that looked like one starting from the
right.

If the data is different, some modifications may be necessary.

I also assumed that the eighth row after the end of the data was blank. Again,
if data is different, a different test will need to be used.

If the data varies so that every eighth row is NOT a Business Name --
Proprietor row, again, changes will be required.

But this should get you started.

Read the comments carefully so as to more easily modify this to your
particulars.

To enter this Macro (Sub), <alt-F11> opens the Visual Basic Editor.
Ensure your project is highlighted in the Project Explorer window.
Then, from the top menu, select Insert/Module and
paste the code below into the window that opens.

To use this Macro (Sub), <alt-F8> opens the macro dialog box. Select the macro
by name, and <RUN>.

===============================
Option Explicit

Sub SplitProprietor()
Dim c As Range
Dim sBusName As String
Dim sProprietor As String
Dim lTitle As Long

'set c to first cell in range to be altered
Set c = Range("A1")

'go to first cell to be split
Set c = c.Offset(rowoffset:=7)

'start Do loop

Do

'get the two parts
'where is the Title?
lTitle = TitlePos(c.Value)
If lTitle = 0 Then
MsgBox ("Data Error at " & c.Address)
Exit Sub
End If
sBusName = Left(c.Value, lTitle - 1)
sProprietor = Mid(c.Value, lTitle + 1)

'move cells down
c.Insert (xlShiftDown)

'insert split data
c.Offset(rowoffset:=-1).Value = sBusName
c.Value = sProprietor

'go to next possible cell to split
Set c = c.Offset(rowoffset:=8)

'check if at end
Loop Until c.Value = ""
End Sub
Private Function TitlePos(s As String) As Long
Dim sTitles As Variant
Dim i As Long
sTitles = Array(" MRS ", " MR ", " MISS ")
For i = 0 To UBound(sTitles)
TitlePos = InStrRev(s, sTitles(i), -1, vbTextCompare)
If TitlePos > 0 Then Exit For
Next i
End Function
===================================
--ron

 

[Ron Rosenfeld]

Private Function TitlePos(s As String) As Long
Dim sTitles As Variant
Dim i As Long
sTitles = Array(" MRS ", " MR ", " MISS ")
For i = 0 To UBound(sTitles)
TitlePos = InStrRev(s, sTitles(i), -1, vbTextCompare)
If TitlePos > 0 Then Exit For
Next i
End Function

This part should, more properly, be written as:

=======================
Private Function TitlePos(s As String) As Long
Dim sTitles As Variant
Dim i As Long
sTitles = Array(" MRS ", " MR ", " MISS ")
For i = LBound(sTitles) To UBound(sTitles)
TitlePos = InStrRev(s, sTitles(i), -1, vbTextCompare)
If TitlePos > 0 Then Exit For
Next i
End Function
========================

--ron