Help replace with wildcard!!!

Nguyen Anh Dung

Board Regular
Joined
Feb 28, 2020
Messages
180
Office Version
  1. 2016
Platform
  1. Windows
i have code vba replace, Thanks to everyone for help replace with wildcard!!!
example: hcm*, *hcm, hcm ??, ??hcm, etc...
code:
Code:
Option Explicit

Sub change_character()
    Dim wb_new As Workbook
    Dim lr As Long
    Dim i As Long, j As Long
    Dim path As String, fpath As String
    Dim arr As Variant
    Dim char_old As String, char_new As String
    Application.DisplayAlerts = False
    Application.AskToUpdateLinks = False
    path = ThisWorkbook.path
    arr = GetFileNames(path)
    char_old = InputBox("Enter char finding:")
    char_new = InputBox("Enter replace char:")
    For i = 1 To UBound(arr) - 1
        For Each wb_new In Workbooks
            If wb_new.Name = arr(i) Then
                lr = Workbooks(wb_new.Name).Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
                For j = 2 To lr
                    Range("B" & j) = Replace(Range("B" & j), char_old, char_new)
                Next j
            Else
                fpath = path & "\" & arr(i)
                Set wb_new = Workbooks.Open(fpath)
                lr = Workbooks(wb_new.Name).Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
                For j = 2 To lr
                    Range("B" & j) = Replace(Range("B" & j), char_old, char_new)
                Next j
                wb_new.Close True
            End If
        Next wb_new
    Next i
    MsgBox "Finised."
    Application.AskToUpdateLinks = True
    Application.DisplayAlerts = True
End Sub

Function GetFileNames(ByVal FolderPath As String) As Variant
Dim Result As Variant
Dim i As Integer
Dim MyFile As Object
Dim MyFSO As Object
Dim MyFolder As Object
Dim MyFiles As Object
Set MyFSO = CreateObject("Scripting.FileSystemObject")
Set MyFolder = MyFSO.GetFolder(FolderPath)
Set MyFiles = MyFolder.Files
ReDim Result(1 To MyFiles.Count)
i = 1
For Each MyFile In MyFiles
Result(i) = MyFile.Name
i = i + 1
Next MyFile
GetFileNames = Result
End Function
Thanks all!!!
 
Another try:
Change in the first code of post # 9, this line:
If Range("O" & j).Value Like char_old Then
For this:
If Lcase(Range("O" & j).Value) Like Lcase(char_old) Then

If you're still having trouble, you could share one of your books to review, use dropbox or google Drive.
Not all information is required, only column "O"
 
Upvote 0

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Another try:
Change in the first code of post # 9, this line:
If Range("O" & j).Value Like char_old Then
For this:
If Lcase(Range("O" & j).Value) Like Lcase(char_old) Then

If you're still having trouble, you could share one of your books to review, use dropbox or google Drive.
Not all information is required, only column "O"
Thank you for the reply. still cannot change.
link file excel: 20200422_22_002_Q9_GS022342.xls
thank you and best regards!!!
 
Upvote 0
I don't understand what you mean by "still cannot change", I tried this macro with your file and the data in column O is replaced,

VBA Code:
Sub change_character()
  Dim wb_new As Workbook, arr As Variant, exists As Boolean
  Dim lr As Long, i As Long, j As Long
  Dim path As String, char_old As String, char_new As String
  
  Application.DisplayAlerts = False
  Application.AskToUpdateLinks = False
  
  path = ThisWorkbook.path
  arr = GetFileNames(path)
  char_old = "ng Không Tên"   'In this case it does not use "*"
  char_new = "new text"           'set new text
  
  For i = 1 To UBound(arr)
    exists = False
    If Left(arr(i), 1) <> "~" And arr(i) <> "" Then
      For Each wb_new In Workbooks
        If wb_new.Name = arr(i) Then
          exists = True
          Exit For
        End If
      Next
      If Not exists Then Set wb_new = Workbooks.Open(path & "\" & arr(i))
      wb_new.Sheets(1).Range("O:O").Replace char_old, char_new, xlPart, xlByRows, False, , False, False
      If Not exists Then wb_new.Close True
    End If
  Next i
  MsgBox "Finised."
  Application.AskToUpdateLinks = True
  Application.DisplayAlerts = True
End Sub


Before running the macro:
1590805287423.png


After running the macro, the data changed to "new text":
1590805579450.png


If you execute the macro step by step,
are your files really in the same folder where you have the file with the macro?
Do you check that the file is opened by the macro?
 
Upvote 0
I don't understand what you mean by "still cannot change", I tried this macro with your file and the data in column O is replaced,

VBA Code:
Sub change_character()
  Dim wb_new As Workbook, arr As Variant, exists As Boolean
  Dim lr As Long, i As Long, j As Long
  Dim path As String, char_old As String, char_new As String
 
  Application.DisplayAlerts = False
  Application.AskToUpdateLinks = False
 
  path = ThisWorkbook.path
  arr = GetFileNames(path)
  char_old = "ng Không Tên"   'In this case it does not use "*"
  char_new = "new text"           'set new text
 
  For i = 1 To UBound(arr)
    exists = False
    If Left(arr(i), 1) <> "~" And arr(i) <> "" Then
      For Each wb_new In Workbooks
        If wb_new.Name = arr(i) Then
          exists = True
          Exit For
        End If
      Next
      If Not exists Then Set wb_new = Workbooks.Open(path & "\" & arr(i))
      wb_new.Sheets(1).Range("O:O").Replace char_old, char_new, xlPart, xlByRows, False, , False, False
      If Not exists Then wb_new.Close True
    End If
  Next i
  MsgBox "Finised."
  Application.AskToUpdateLinks = True
  Application.DisplayAlerts = True
End Sub


Before running the macro:
View attachment 15083

After running the macro, the data changed to "new text":
View attachment 15086

If you execute the macro step by step,
are your files really in the same folder where you have the file with the macro?
Do you check that the file is opened by the macro?
it's mean change street in this case wildcard :
Đường không Tên 03-> empty.
example: Đường không Tên 03, Đường không Tên 02,Đường không Tên 01->"". (* Đường Không tên *->"")
 
Upvote 0
it's mean change street in this case wildcard :
Đường không Tên 03-> empty.
example: Đường không Tên 03, Đường không Tên 02,Đường không Tên 01->"". (* Đường Không tên *->"")

old_textNew_text
Đường Không Tên 05
Đường Không Tên 05
Đường Không Tên 05
Đường 410AĐường 410A
Đường 410AĐường 410A
Đường 410AĐường 410A
Đường Không Tên 03
Đường Không Tên 03
Đường Không Tên 03
 
Upvote 0
VBA Code:
  char_old = "ng Không Tên"   'In this case it does not use "*"
  char_new = "new text"           'set new text

The content of the char_old variable will be replaced in the cell by the content of the char_new variable.

I tried that with the macro and it works for me. Did you see my images?
Is that what you need?
Or I am not understanding what you need.
 
Upvote 0
it's mean change street in this case wildcard :
Đường không Tên 03-> empty.
Sorry I still don't understand what you want.
You can put 2 images.
Image 1, original data (before making changes)
Image 2, desired data.
In both images I want to see the rows and columns of excel (just as I put the images)
 
Upvote 0
Sorry I still don't understand what you want.
You can put 2 images.
Image 1, original data (before making changes)
Image 2, desired data.
In both images I want to see the rows and columns of excel (just as I put the images)
yes, i have upload image_1 (before making changes) and result image_2
 

Attachments

  • image1_before.jpg
    image1_before.jpg
    143.9 KB · Views: 5
  • image2_after.jpg
    image2_after.jpg
    94.6 KB · Views: 6
Upvote 0
The VBA editor does not allow some characters that it considers as graphic characters, so we cannot put these characters in the code:
"Đường Không Tên*"
So we can put something like this:
"*ng Không Tên*"

Then try:

VBA Code:
Sub change_character()
  Dim wb_new As Workbook, arr As Variant, exists As Boolean
  Dim lr As Long, i As Long, j As Long
  Dim path As String, char_old As String, char_new As String
  Dim a As Variant
  
  Application.DisplayAlerts = False
  Application.AskToUpdateLinks = False
  
  path = ThisWorkbook.path
  arr = GetFileNames(path)
  char_old = "*ng Không Tên*"
  char_new = ""
  
  For i = 1 To UBound(arr)
    exists = False
    If Left(arr(i), 1) <> "~" And arr(i) <> "" Then
      For Each wb_new In Workbooks
        If wb_new.Name = arr(i) Then
          exists = True
          Exit For
        End If
      Next
      If Not exists Then Set wb_new = Workbooks.Open(path & "\" & arr(i))
      a = wb_new.Sheets(1).Range("O1", wb_new.Sheets(1).Range("O" & Rows.Count).End(3)).Value2
      For j = 1 To UBound(a)
        If LCase(a(j, 1)) Like LCase(char_old) Then
          a(j, 1) = char_new
        End If
      Next
      wb_new.Sheets(1).Range("O1").Resize(UBound(a)).Value = a
      If Not exists Then wb_new.Close True
    End If
  Next i
  MsgBox "Finised."
  Application.AskToUpdateLinks = True
  Application.DisplayAlerts = True
End Sub

Please try this macro. If you modify the macro, you tell me what changes you made to it.
 
Upvote 0
The VBA editor does not allow some characters that it considers as graphic characters, so we cannot put these characters in the code:
"Đường Không Tên*"
So we can put something like this:
"*ng Không Tên*"

Then try:

VBA Code:
Sub change_character()
  Dim wb_new As Workbook, arr As Variant, exists As Boolean
  Dim lr As Long, i As Long, j As Long
  Dim path As String, char_old As String, char_new As String
  Dim a As Variant
 
  Application.DisplayAlerts = False
  Application.AskToUpdateLinks = False
 
  path = ThisWorkbook.path
  arr = GetFileNames(path)
  char_old = "*ng Không Tên*"
  char_new = ""
 
  For i = 1 To UBound(arr)
    exists = False
    If Left(arr(i), 1) <> "~" And arr(i) <> "" Then
      For Each wb_new In Workbooks
        If wb_new.Name = arr(i) Then
          exists = True
          Exit For
        End If
      Next
      If Not exists Then Set wb_new = Workbooks.Open(path & "\" & arr(i))
      a = wb_new.Sheets(1).Range("O1", wb_new.Sheets(1).Range("O" & Rows.Count).End(3)).Value2
      For j = 1 To UBound(a)
        If LCase(a(j, 1)) Like LCase(char_old) Then
          a(j, 1) = char_new
        End If
      Next
      wb_new.Sheets(1).Range("O1").Resize(UBound(a)).Value = a
      If Not exists Then wb_new.Close True
    End If
  Next i
  MsgBox "Finised."
  Application.AskToUpdateLinks = True
  Application.DisplayAlerts = True
End Sub

Please try this macro. If you modify the macro, you tell me what changes you made to it.
thankyou so much!!!
 
Upvote 0

Forum statistics

Threads
1,213,491
Messages
6,113,963
Members
448,536
Latest member
CantExcel123

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