Macro: How to find & replace periods if they are preceded by characters

H

halinc

New Member
Joined
Nov 7, 2013
Messages
20
Office Version
  1. 2016
Platform
  1. Windows
Hi,
I have a set of data that I am splitting with a macro based on period placement. For example, this:
1. Joe Smith 2. Mary White 3. Ted Jones

is split into:
Joe Smith
Mary White
Ted Jones


My macro works fine except when someone has a period in their name, which creates a situation such as:
1. Joe Smith 2. J.R. Smith 3. Mary White

split into:
Joe Smith
J
R
Smith
Mary White


Is there a way I can have my macro search for periods that are preceded by characters (rather than numbers)? And then replace those periods with a space or some other character?

Thanks for any help!
Hal
 
Sort by date Sort by votes

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
Ya, sorry, it's just this is a small part of a big, old macro, so I didn't want to overcomplicated things. Which is exactly what I seem to have done!

So here is another attempt at explaining this.
I get data like this:
[TABLE="class: grid, width: 500"]
<colgroup><col><col></colgroup><tbody>[TR]
[TD="align: left"]Case ID[/TD]
[TD="align: left"]Participant Name
[/TD]
[/TR]
[TR]
[TD]8456
[/TD]
[TD]1. Joe Smith
2. Mary White
3. Ted Jones
4. J.R. Smith
[/TD]
[/TR]
[TR]
[TD]2148[/TD]
[TD]Ted Black[/TD]
[/TR]
[TR]
[TD]621[/TD]
[TD]1. Joe Smith
2. Mary White
3. Ted Jones
4. J.R. Smith
[/TD]
[/TR]
[TR]
[TD]54865
[/TD]
[TD]Gina Todd[/TD]
[/TR]
[TR]
[TD]35748[/TD]
[TD]1. Bill Clinton
2. George Bush[/TD]
[/TR]
</tbody>[/TABLE]

And I need to end up with this:
[TABLE="class: grid, width: 500"]
<colgroup><col><col><col span="3"></colgroup><tbody>[TR]
[TD="align: left"]Case ID
[/TD]
[TD="align: left"]Participant Name[/TD]
[TD="align: left"]Participant Name[/TD]
[TD="align: left"]Participant Name[/TD]
[TD="align: left"]Participant Name[/TD]
[/TR]
[TR]
[TD="align: right"]8456[/TD]
[TD="align: left"]Joe Smith[/TD]
[TD="align: left"]Mary White[/TD]
[TD="align: left"]Ted Jones
[/TD]
[TD="align: left"]J.R. Smith
[/TD]
[/TR]
[TR]
[TD="align: right"]2148[/TD]
[TD="align: left"]Ted Black[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]621[/TD]
[TD="align: left"]Joe Smith
[/TD]
[TD="align: left"]Mary White[/TD]
[TD="align: left"]Ted Jones[/TD]
[TD="align: left"]J.R. Smith
[/TD]
[/TR]
[TR]
[TD="align: right"]54865
[/TD]
[TD="align: left"]Gina Todd
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]35748
[/TD]
[TD="align: left"]Bill Clinton
[/TD]
[TD]George Bush
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

To feed into the next step of the macro.
 
Upvote 0
An extra IF could do the trick :)

Code: 
Sub RTGF()
    Dim Reg As Object
    Set Reg = CreateObject("VBScript.RegExp")
    Dim g
    Dim t As String
    Dim k As Long: k = 0
    While Not Range("A1").Offset(k).Value = vbNullString
        If InStr(Range("A1").Offset(k).Value, ".") > 0 Then
            t = Mid(Range("A1").Offset(k).Value, InStr(Range("A1").Offset(k).Value, " ") + 1)
            With Reg
                .Global = 1
                .IgnoreCase = 1
                .Pattern = "\s?[0-9]+\.\s"
                g = Split(.Replace(t, "&"), "&")
            End With
            Range("A1").Offset(k, 2).Resize(, UBound(g) + 1).Value = g
        Else
            Range("A1").Offset(k, 2).Value = Range("A1").Offset(k).Value
        End If
        k = k + 1
    Wend
    Set Reg = Nothing
    MsgBox "Data successfully split."
End Sub
 
Upvote 0
halinc said:
Ya, sorry, it's just this is a small part of a big, old macro, so I didn't want to overcomplicated things. Which is exactly what I seem to have done!

So here is another attempt at explaining this.
I get data like this:
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD="align: left"]Case ID[/TD]
[TD="align: left"]Participant Name[/TD]
[/TR]
[TR]
[TD]8456[/TD]
[TD]1. Joe Smith
2. Mary White
3. Ted Jones
4. J.R. Smith[/TD]
[/TR]
[TR]
[TD]2148[/TD]
[TD]Ted Black[/TD]
[/TR]
[TR]
[TD]621[/TD]
[TD]1. Joe Smith
2. Mary White
3. Ted Jones
4. J.R. Smith[/TD]
[/TR]
[TR]
[TD]54865[/TD]
[TD]Gina Todd[/TD]
[/TR]
[TR]
[TD]35748[/TD]
[TD]1. Bill Clinton
2. George Bush[/TD]
[/TR]
</tbody>[/TABLE]

And I need to end up with this:
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD="align: left"]Case ID[/TD]
[TD="align: left"]Participant Name[/TD]
[TD="align: left"]Participant Name[/TD]
[TD="align: left"]Participant Name[/TD]
[TD="align: left"]Participant Name[/TD]
[/TR]
[TR]
[TD="align: right"]8456[/TD]
[TD="align: left"]Joe Smith[/TD]
[TD="align: left"]Mary White[/TD]
[TD="align: left"]Ted Jones[/TD]
[TD="align: left"]J.R. Smith[/TD]
[/TR]
[TR]
[TD="align: right"]2148[/TD]
[TD="align: left"]Ted Black[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]621[/TD]
[TD="align: left"]Joe Smith[/TD]
[TD="align: left"]Mary White[/TD]
[TD="align: left"]Ted Jones[/TD]
[TD="align: left"]J.R. Smith[/TD]
[/TR]
[TR]
[TD="align: right"]54865[/TD]
[TD="align: left"]Gina Todd[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]35748[/TD]
[TD="align: left"]Bill Clinton[/TD]
[TD]George Bush[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

To feed into the next step of the macro.
Click to expand...

Here is the modified version of my macro that handles the names you show and produces the table you say you need to end up with...
Code: 
Sub RTGF2()
  Dim LastRow As Long, LastCol As Long
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  With Range("B2:B" & LastRow)
    .Value = Evaluate("Char(10)&IF(NOT(ISNUMBER(-LEFT(B2:B" & LastRow & "))),""."","""")&B2:B" & LastRow)
    .Replace vbLf & "*" & ".", "&", xlPart
    .TextToColumns Range("B2"), xlDelimited, , , False, False, False, False, True, "&"
    .Delete xlShiftToLeft
  End With
  LastCol = Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, LookIn:=xlValues).Column
  Range("C1").Resize(, LastCol - 2).Value = Range("B1").Value
  Columns("A").Resize(, LastCol).AutoFit
End Sub
The last two lines of code may not be needed by you as all they do is "tidy" things up some... what they do is spread the header "Participant Name" across the columns and then autofit the width of the filled in columns.
 
Last edited:
Upvote 0
VBA Geek--For situations where there is a blank row (only happens when there are multiple lines in the cell), like below:
1.
2. [name]

is there a way to have to macro add a space? So the output of the above would be a cell with just a space, then a cell to the right with the name. Or if it would be easier, just add a space after each of those values (so there would be extra spaces after the names as well)? I have now found that when there is an empty cell, the next step in the macro doesn't work. But if there is at least a space in the cell, it will work.
 
Upvote 0
halinc said:
VBA Geek--For situations where there is a blank row (only happens when there are multiple lines in the cell), like below:
1.
2. [name]

is there a way to have to macro add a space? So the output of the above would be a cell with just a space, then a cell to the right with the name. Or if it would be easier, just add a space after each of those values (so there would be extra spaces after the names as well)? I have now found that when there is an empty cell, the next step in the macro doesn't work. But if there is at least a space in the cell, it will work.
Click to expand...

Did you try the code I posted... it already does that.
 
Upvote 0
nice, i started venturing into regex because i missed the part where there were carriage returns otherwise i'd have tried something else as well, regex might be a bit heavy but never disappoints you ;)

Rick Rothstein said:
Here is the modified version of my macro that handles the names you show and produces the table you say you need to end up with...
Code: 
Sub RTGF2()
  Dim LastRow As Long, LastCol As Long
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  With Range("B2:B" & LastRow)
    .Value = Evaluate("Char(10)&IF(NOT(ISNUMBER(-LEFT(B2:B" & LastRow & "))),""."","""")&B2:B" & LastRow)
    .Replace vbLf & "*" & ".", "&", xlPart
    .TextToColumns Range("B2"), xlDelimited, , , False, False, False, False, True, "&"
    .Delete xlShiftToLeft
  End With
  LastCol = Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, LookIn:=xlValues).Column
  Range("C1").Resize(, LastCol - 2).Value = Range("B1").Value
  Columns("A").Resize(, LastCol).AutoFit
End Sub
The last two lines of code may not be needed by you as all they do is "tidy" things up some... what they do is spread the header "Participant Name" across the columns and then autofit the width of the filled in columns.
Click to expand...
 
Upvote 0
yes that is because the loop is constructed to stop as soon as it encounters an empty cell, the fix would be to have a for next loop from row 1 untill the last row of data

you would have to do

Code: 
Sub RTGF()
    Dim Reg As Object
    Set Reg = CreateObject("VBScript.RegExp")
    Dim g
    Dim t As String
    Dim k As Long
    For k = 1 To Range("A" & Rows.Count).End(xlUp).Row
        If InStr(Range("A1").Offset(k - 1).Value, ".") > 0 Then
            t = Mid(Range("A1").Offset(k - 1).Value, InStr(Range("A1").Offset(k - 1).Value, " ") + 1)
            With Reg
                .Global = 1
                .IgnoreCase = 1
                .Pattern = "\s?[0-9]+\.\s"
                g = Split(.Replace(t, "&"), "&")
            End With
            Range("A1").Offset(k - 1, 2).Resize(, UBound(g) + 1).Value = g
        Else
            Range("A1").Offset(k - 1, 2).Value = Range("A1").Offset(k - 1).Value
        End If
        
    Next
    Set Reg = Nothing
    MsgBox "Data successfully split."
End Sub






halinc said:
VBA Geek--For situations where there is a blank row (only happens when there are multiple lines in the cell), like below:
1.
2. [name]

is there a way to have to macro add a space? So the output of the above would be a cell with just a space, then a cell to the right with the name. Or if it would be easier, just add a space after each of those values (so there would be extra spaces after the names as well)? I have now found that when there is an empty cell, the next step in the macro doesn't work. But if there is at least a space in the cell, it will work.
Click to expand...
 
Last edited:
Upvote 0
VBA Geek said:
nice, i started venturing into regex because i missed the part where there were carriage returns otherwise i'd have tried something else as well, regex might be a bit heavy but never disappoints you ;)
Click to expand...
It has been my experience that RegExp is almost never needed to accomplish the tasks people ask here... and the timing results, on average, tend to even out (which is better to use usually depends on how much data has to be processed, but the time differences, in total, are usually not significant on a human noticeability scale. Also, the non-RegExp solutions tend to be, line-wise, a touch more concise as well (at least the way I tend to write them, that is
icon_laugh.gif
).
 
Last edited:
Upvote 0
Ah, yes, sorry, my fault, I feel like I'm playing whack-a-mole with this! One more thing I found which hopefully isn't a major fix--there are some entries with "&", and the "&" is causing the value to be parsed (so "part1 & part2" is split with "part1" in one cell and "part2" in another, when I would need "part1 & part2" to stay in one cell). Any way to fix this?
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question Question
How do i open a csv file created in excel and do a find and replace of this file and save as a new file without strange characters ??
Replies
1
Views
902
Special-K99
S
J
  • Question Question
Multiple Find and Replace Using a List of Old Values with New Values
Replies
2
Views
783
Peter_SSs
Peter_SSs
T
  • Question Question
Extracting First Name and Surname from Email Addresses
Replies
7
Views
4K
Fluff
Fluff
T
  • Solved
Replace part/full strings with arrays in VBA
Replies
8
Views
3K
tjdickinson
T
D
  • Question Question
VBA search script to ignore certain characters
Replies
0
Views
864
dmj120
D

Forum statistics

Threads
1,223,911
Messages
6,175,337
Members
452,637
Latest member
Ezio2866

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top