Help replace with wildcard!!!

[Nguyen Anh Dung]

i have code vba replace, Thanks to everyone for help replace with wildcard!!!
example: hcm*, *hcm, hcm ??, ??hcm, etc...
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!!!

 

[DanteAmor]

You can explain it with a couple of examples:

char_old = (What data do you put?)
char_new = (What data do you put?)

Range("B" & j) = (What data do you have?)

Range("B" & j) = (What data do you want?)

 

[Nguyen Anh Dung]

You can explain it with a couple of examples:

char_old = (What data do you put?)
char_new = (What data do you put?)

Range("B" & j) = (What data do you have?)

Range("B" & j) = (What data do you want?)

yes, i have change code. but when run column O empty all.
I only repleace "Đường Không tên 01"->"". But when run Đường Nguyễn Văn A column empty.

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 = ("???ng Không Tên ??")
    char_new = ("")
    '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("O" & Rows.Count).End(xlUp).Row
                For j = 2 To lr
                    'Range("N" & j) = Replace(Range("N" & j), char_old, char_new)
                    Range("O" & j) = ("???ng Không Tên ??")
                    Range("O" & j) = ("")
                Next j
            Else
                fpath = path & "\" & arr(i)
                Set wb_new = Workbooks.Open(fpath)
                lr = Workbooks(wb_new.Name).Sheets(1).Range("O" & Rows.Count).End(xlUp).Row
                For j = 2 To lr
                    'Range("V" & j) = Replace(Range("V" & j), char_old, char_new)
                    Range("O" & j) = ("???ng Không Tên ??")
                    Range("O" & j) = ("")
                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 you so much!!!

 

[Nguyen Anh Dung]

link file: test_file

 

[mole999]

Range("O" & j) = ("")

 

[Nguyen Anh Dung]

Range("O" & j) = ("")

yes, i have column O:
Đường Nguyễn Văn An
Đường Nguyễn Văn An
Đường Nguyễn Văn An
Đường Nguyễn Văn An
Đường Không Tên 01
Đường Không Tên 02
Đường Không Tên 03
Đường Không Tên 01
i only want run repleace "Đường Không Tên ??" into a "". But when run code all rows column O is empty.

 

[mole999]

Range("O" & j) = ("")
that tells the code to run down and make empty

 

[Nguyen Anh Dung]

Range("O" & j) = ("")
that tells the code to run down and make empty

you can help me!!!
yes, i have column O:
Đường Nguyễn Văn An
Đường Nguyễn Văn An
Đường Nguyễn Văn An
Đường Nguyễn Văn An
Đường Không Tên 01
Đường Không Tên 02
Đường Không Tên 03
Đường Không Tên 01

result
Đường Nguyễn Văn An
Đường Nguyễn Văn An
Đường Nguyễn Văn An
Đường Nguyễn Văn An
empty
empty
empty
empty

 

[DanteAmor]

I checked the code and was not properly checking open books and closed books. I made some changes.
I also put the Like statement to use the wildcard "*"

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*"
  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))
      lr = wb_new.Sheets(1).Range("O" & Rows.Count).End(xlUp).Row
      For j = 2 To lr
        If Range("O" & j).Value Like char_old Then
          Range("O" & j).Value = char_new
        End If
      Next j
      If Not exists Then wb_new.Close True
    End If
  Next i
  MsgBox "Finised."
  Application.AskToUpdateLinks = True
  Application.DisplayAlerts = True
End Sub

_________________________________________________________________________________________________________
The previous option is to replace all the contents of the cell if the "char_old" data exists inside the cell.

But if you want to replace only the "char_old" data with a char_new data, then you could use the following:

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

 

[Nguyen Anh Dung]

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*" 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)) lr = wb_new.Sheets(1).Range("O" & Rows.Count).End(xlUp).Row For j = 2 To lr If Range("O" & j).Value Like char_old Then Range("O" & j).Value = char_new End If Next j If Not exists Then wb_new.Close True End If Next i MsgBox "Finised." Application.AskToUpdateLinks = True Application.DisplayAlerts = True End Sub

Thanks DanteAmor!!!
i have check code use the wildcard "*" but run code column O not change.
Đường Không Tên 03 when run not change.