Curious problem with a find and replace macro?

D

dougmarkham

Active Member
Joined
Jul 19, 2016
Messages
252
Office Version
  1. 365
Platform
  1. Windows
Hi Folks,

I have a column of data (column H) headed [customer reference]. Customer reference data is populated by users when they book a courier online.


  • They have to input a client customer number (3 digits), a sales order number and a check digit, each element separated by a hashtag (so later I can text-to-columns on using the # character as delimiter).
e.g., 100#1000001#100


​

  • However, in haste users often make errors such as:
e.g., 100##1000001/100​


Analysing many invoices, I compiled a find-&-replace table: column A (find) and column B (replace).

For replacing one element within a string e.g., "/" with the hashtag "#", I have the following code that works: 100##1000001/100 becomes 100#1000001#100
Code: 
Sub FindNReplaceForSlashToHash()


    Worksheets("Invoice").Activate
    Application.Goto Reference:=Range("InvoiceTable[Customer reference]")
    Selection.Replace what:="/", replacement:="#", LookAt:=[COLOR=#0000cd][B]xlPart[/B][/COLOR], _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace what:="##", replacement:="#", LookAt:=[COLOR=#0000cd][B]xlPart[/B][/COLOR], _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False


End Sub

Whilst this works, I have found over 100 errors to account for. I would therefore like to use a Find and Replace table for the VBA code to refer to, e.g.,

Code: 
Sub Multi_FindReplace()


Dim sht As Worksheet
Dim fndList As Integer
Dim rplcList As Integer
Dim tbl As ListObject
Dim myArray As Variant


[COLOR=#006400]'Create variable to point to your table[/COLOR]
  Set tbl = Worksheets("FindNReplace").ListObjects("FindNReplaceTable")


[COLOR=#006400]'Create an Array out of the Table's Data[/COLOR]
  Set TempArray = tbl.DataBodyRange
  myArray = Application.Transpose(TempArray)
  
[COLOR=#006400]'Designate Columns for Find/Replace data[/COLOR]
  fndList = 1
  rplcList = 2


[COLOR=#006400]'Loop through each item in Array lists[/COLOR]
  For x = LBound(myArray, 1) To UBound(myArray, 2)
    'Loop through each worksheet in ActiveWorkbook (skip sheet with table in it)
      Range("InvoiceTable[Customer reference]").Select
          Selection.Cells.Replace what:=myArray(fndList, x), replacement:=myArray(rplcList, x), _
            LookAt:=[COLOR=#0000cd][B]xlPart[/B][/COLOR], SearchOrder:=xlByRows, MatchCase:=False, _
            SearchFormat:=False, ReplaceFormat:=False
  Next x

End Sub

The problem is as follows: when I run this vba code, the text string I wish to modify goes from:


100##1000001/100dlm becomes #

 rather than

100##1000001/100dlm becomes 100#1000001#100dlm


Would anybody be willing to help me modify this VBA to find-and-replace only the element within the string rather than finding the element and replacing the whole string?

Kind regards,

Doug.
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Sort by date Sort by votes
Without anything to test on it's a bit difficult, but how about
Code: 
Sub Multi_FindReplace()
   Dim sht As Worksheet
   Dim fndList As Integer
   Dim rplcList As Integer
   Dim tbl As ListObject
   Dim myArray As Variant

'Create variable to point to your table
  Set tbl = Worksheets("FindNReplace").ListObjects("FindNReplaceTable")

'Create an Array out of the Table's Data
  myArray = tbl.DataBodyRange.Value2

'Loop through each item in Array lists
  For x = LBound(myArray, 1) To UBound(myArray, 1)
      Range("InvoiceTable[Customer reference]").Select
          Selection.Cells.Replace what:=myArray(x, 1), replacement:=myArray(x, 2), _
            LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
            SearchFormat:=False, ReplaceFormat:=False
  Next x
End Sub
 
Upvote 0
Another option - probaly a bit slower than @Fluff code
Test on a copy of your workbook!

Code: 
Sub ReplaceChars()
    Dim Tx As String, c As Long, cTx As Long, Cel As Range
    For Each Cel In Range("InvoiceTable[Customer reference]")
        On Error Resume Next
        Tx = Cel.Value: cTx = Len(Tx)
        For c = 1 To cTx
            Select Case Mid(Cel, c, 1)
                Case 0, 1, 2, 3, 4, 5, 6, 7, 8, 9
                Case Else: Tx = Left(Tx, c - 1) & " " & Right(Tx, cTx - c)
            End Select
        Next c
            Tx = Replace(WorksheetFunction.Trim(Tx), " ", "#")
            Cel = Tx
    Next Cel
End Sub
 
Upvote 0
Fluff said:
Without anything to test on it's a bit difficult, but how about
Code: 
Sub Multi_FindReplace()
   Dim sht As Worksheet
   Dim fndList As Integer
   Dim rplcList As Integer
   Dim tbl As ListObject
   Dim myArray As Variant

'Create variable to point to your table
  Set tbl = Worksheets("FindNReplace").ListObjects("FindNReplaceTable")

'Create an Array out of the Table's Data
  myArray = tbl.DataBodyRange.Value2

'Loop through each item in Array lists
  For x = LBound(myArray, 1) To UBound(myArray, 1)
      Range("InvoiceTable[Customer reference]").Select
          Selection.Cells.Replace what:=myArray(x, 1), replacement:=myArray(x, 2), _
            LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
            SearchFormat:=False, ReplaceFormat:=False
  Next x
End Sub
Click to expand...

Hi Fluff,

Thanks for the reply,

Your modification seems to work the same way (i.e., replacing the whole cell with the replace element (#) as the original code, albeit more efficient code.

Here is example data:

Customer Ref Column (ws = Invoice)
[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]Customer Reference [/TD]
[/TR]
[TR]
[TD][TABLE="width: 189"]
<colgroup><col></colgroup><tbody>[TR]
[TD]113#4094643#116[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD]113#4096062/98[/TD]
[/TR]
[TR]
[TD]068# 4093947#45sd[/TD]
[/TR]
[TR]
[TD]091*#4096890/003[/TD]
[/TR]
[TR]
[TD]125##4096031[/TD]
[/TR]
[TR]
[TD]113#@4094743/122[/TD]
[/TR]
[TR]
[TD]113#4092551#65[/TD]
[/TR]
[TR]
[TD]091~#4092385/47[/TD]
[/TR]
[TR]
[TD]091#4091436#/12[/TD]
[/TR]
</tbody>[/TABLE]


















Find n replace data (Worksheets =FindNReplace; Table = FindNReplaceTable)

[TABLE="width: 500"]
<tbody>[TR]
[TD]Find[/TD]
[TD]Replace[/TD]
[/TR]
[TR]
[TD]##[/TD]
[TD]#[/TD]
[/TR]
[TR]
[TD]/[/TD]
[TD]#[/TD]
[/TR]
[TR]
[TD]*#[/TD]
[TD]#[/TD]
[/TR]
[TR]
[TD]#@[/TD]
[TD]#[/TD]
[/TR]
[TR]
[TD]~#[/TD]
[TD]#[/TD]
[/TR]
[TR]
[TD]#/[/TD]
[TD]#[/TD]
[/TR]
[TR]
[TD]/#[/TD]
[TD]#[/TD]
[/TR]
[TR]
[TD]etc[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Curiously, elements on the left hand side of the # disappear first, then the right hand elements:
e.g., 113#4092551#65 --> #4092551#65-->#, and there isn't even a single # in the find column??

Could it be due to the way excel interprets punctuation?

Kind regards,

Doug.
 
Upvote 0
I suspect that this *# is the culprit from those that you have show as the * is interpreted as a wildcard
Change it to ~*# and also change ~# to ~~#

you can also slim it down slightly by changing the order


Excel 2013/2016
AB
2/#
3~*##
4#@#
5~~##
6###
FindNReplace
 
Upvote 0
Fluff said:
I suspect that this *# is the culprit from those that you have show as the * is interpreted as a wildcard
Change it to ~*# and also change ~# to ~~#

you can also slim it down slightly by changing the order

Excel 2013/2016
AB
/#
~*##
#@#
~~##
###

<colgroup><col style="width: 25pxpx"><col><col></colgroup><thead>
</thead><tbody>
[TD="align: center"]2[/TD]

[TD="align: center"]3[/TD]

[TD="align: center"]4[/TD]

[TD="align: center"]5[/TD]

[TD="align: center"]6[/TD]

</tbody>
FindNReplace​
Click to expand...

Hi Fluff,

That's really useful information to know (using ~ prior to ' and * in order for excel to interpret them as text characters).

I changed the Find and replace table formatting to text and made your suggested changes, and it worked first time.

Many thanks for your help!

Kind regards,

Doug.
 
Upvote 0
Glad to help & thanks for the feedback
 
Upvote 0
You must log in or register to reply here.

Similar threads

Y
  • Question Question
Macro to find & replace from source table - need to match whole source table string to partial string in workbook
Replies
1
Views
427
Kaper
Kaper
M
  • Question Question
Match cell contents exactly for find and replace based on a table
Replies
3
Views
799
mumps
mumps
JeffGrant
  • Question Question
Find & Replace is searching whole workbook instead of just the sheet
Replies
7
Views
727
bobsan42
bobsan42
V
  • Question Question
US/European Date Format Updates Not Working on Macro Run
Replies
0
Views
128
vancher19
V
L
  • Question Question
How to loop to find and replace with the specific cells
Replies
2
Views
339
Linda Lo
L

Forum statistics

Threads
1,224,815
Messages
6,181,136
Members
453,021
Latest member
Justyna P

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