Curious problem with a find and replace macro?

[dougmarkham]

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

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.,

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.

 

[Fluff]

Without anything to test on it's a bit difficult, but how about

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

 

[Yongle]

Another option - probaly a bit slower than @Fluff code
Test on a copy of your workbook!

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

 

[dougmarkham]

Without anything to test on it's a bit difficult, but how about

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

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.

 

[Fluff]

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
	A	B
2	/	#
3	~*#	#
4	#@	#
5	~~#	#
6	##	#
FindNReplace

 

[dougmarkham]

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

	A	B
/	#
~*#	#
#@	#
~~#	#
##	#

<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​

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.

 

[Fluff]

Glad to help & thanks for the feedback