Page 1 of 3 123 LastLast
Results 1 to 10 of 23

Thread: Find and Replace any characters in a list of characters

  1. #1
    Board Regular
    Join Date
    Aug 2019
    Posts
    76
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Find and Replace any characters in a list of characters

    Hi,
    i could really use some help with this.

    i have this code that checks a column for an illegal character (for sheet name) and replaces it with "_".
    I want it to check for the fill list of characters that are not allowable sheet names
    Code:
     .Pattern = "[\<\>\*\\\/\?|]"
    Code:
    Sub ReplaceIllegalCharacters()    'this code searches column "I" for "\" and replaces it with "_"
    
        Columns("I").Replace What:="\", _
                                Replacement:="_", _
                                LookAt:=xlPart, _
                                SearchOrder:=xlByRows, _
                                MatchCase:=False, _
                                SearchFormat:=False, _
                                ReplaceFormat:=False
    End Sub

    Additionally, since the script is already going through the same column to check for blanks and delete empty rows, i thought it would be most efficient to combine it with this other function...

    Code:
    'This code looks at column I for blanks and deletes the entire row were it finds them.
    
    For j = Cells(Rows.Count, "I").End(xlUp).Row To 1 Step -1    On Error Resume Next
        
        If Cells(j, "I") = "" Then Cells(j, "I").EntireRow.Delete xlUp
        Next j
    Thanks for any help

  2. #2
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    28,203
    Post Thanks / Like
    Mentioned
    470 Post(s)
    Tagged
    47 Thread(s)

    Default Re: Find and Replace any characters in a list of characters

    You could use
    Code:
    Function ValidWBName(Arg As String) As String
    ' Andrew Poulsom
        Dim RegEx As Object
        Set RegEx = CreateObject("VBScript.RegExp")
        With RegEx
            .Pattern = "[\\/:\*\?""<>\|]"
            .Global = True
            ValidWBName = .Replace(Arg, "_")
        End With
    End Function
    & called like
    Code:
    Sub Davavo()
       Dim Fname As String
       
       Fname = "Abc\de/fg|hi"
       Fname = ValidWBName(Fname)
    End Sub
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

  3. #3
    Board Regular
    Join Date
    Aug 2019
    Posts
    76
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Find and Replace any characters in a list of characters

    so, combining the two scripts, this works .... but only searches for one character.

    How do I search for the array?

    Can anyone help with the syntax, if that is what is required, or how to integrate a loop of some kind?

    Thanks

    Code:
     For j = Cells(Rows.Count, "I").End(xlUp).Row To 1 Step -1    On Error Resume Next
        
        If Cells(j, "I") <> "" Then
        
        Cells(j, "I").Replace What:="/", _
                                Replacement:="_", _
                                LookAt:=xlPart, _
                                SearchOrder:=xlByRows, _
                                MatchCase:=False, _
                                SearchFormat:=False, _
                                ReplaceFormat:=False
        
        Else
        
        Cells(j, "I").EntireRow.Delete xlUp
        End If
        
        
        Next j

  4. #4
    Board Regular
    Join Date
    Aug 2019
    Posts
    76
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Find and Replace any characters in a list of characters

    hello again fluff.
    Thanks for your response. I must have been writing my own at the time.
    I think i saw that script. It may have been where i copied the list from. But i dont really understand it.
    Is that just for one cell? So i should call it repeatedly within a loop for the range?

    Like
    Code:
     For j = Cells(Rows.Count, "I").End(xlUp).Row To 1 Step -1    On Error Resume Next    
        If Cells(j, "I") <> "" Then
    
    Call Davavo
      
        Else
        
        Cells(j, "I").EntireRow.Delete xlUp
        End If
        
             Next j

  5. #5
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    28,203
    Post Thanks / Like
    Mentioned
    470 Post(s)
    Tagged
    47 Thread(s)

    Default Re: Find and Replace any characters in a list of characters

    Depends on what you are trying to do.
    You said
    I want it to check for the fill list of characters that are not allowable sheet names
    So I assumed that you were creating new sheets, if so can you post your entire code.
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

  6. #6
    Board Regular
    Join Date
    Aug 2019
    Posts
    76
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Find and Replace any characters in a list of characters

    Quote Originally Posted by Fluff View Post
    Depends on what you are trying to do.
    You saidSo I assumed that you were creating new sheets, if so can you post your entire code.
    New sheets will be created from this data. I figured this should be part of the import script.

    Code:
    Sub InvoiceReadMacro()
    
      Dim wb As Workbook
      Dim tw As Workbook
      Dim ws As Worksheet
      Dim Trgtws As Worksheet, myFile
      Dim ob As ListObject
      Dim Lrow1 As Long
      Dim Usdrws As Long
      Dim LastRow As Long
      Dim Testcell As Range
      Dim INVRead As Worksheet
      Dim j As Long
      Dim CheckHeader As Range
      
      Set tw = ThisWorkbook
      Set Trgtws = tw.Sheets("INVRead")
      Set Testcell = Trgtws.Cells(3, 9)
      
      Sheets("INVRead").Unprotect password:="****"
      Sheets("INVRead").Visible = True
       
    ' Turn off hogs
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
      
    Trgtws.Range("A2:N2").Select
    With Trgtws.ListObjects("TINVRead")
                   .ShowTotals = False
    End With
    
    
    
    
    Selection.Font.Color = vbBlack
    Range("A2:N2").Font.Bold = False
    Application.CutCopyMode = False
    
    
      'open workbook
      myFile = Application.GetOpenFilename(, , "Browse for Workbook")
      
      If myFile = False Then
      MsgBox "No File Selected, Cannot continue"
      Exit Sub
      End If
      
      
      With Workbooks.Open(myFile)
      
      Set wb = Workbooks.Open(FileName:=myFile, ReadOnly:=False)
      
       
    For Each ws In wb.Worksheets
    
    
    Set CheckHeader = ws.Range("I1")
    
    
    If InStr(CheckHeader.Value, "Invoice Type") = 1 Then
        
        On Error Resume Next
        Columns.EntireColumn.Hidden = False
        Rows.EntireRow.Hidden = False
        
    If ws.Visible = True Then
        ws.Activate
        ActiveWindow.FreezePanes = False
    End If
        
        ActiveSheet.Cells.ClearFormats
           
        '-----------------------------------------------------------------------------------------------------------------------------------------starts here
            
        For j = Cells(Rows.Count, "I").End(xlUp).Row To 1 Step -1
        On Error Resume Next
        
        If Cells(j, "I") <> "" Then
        
        Cells(j, "I").Replace What:="/", _
                                Replacement:="_", _
                                LookAt:=xlPart, _
                                SearchOrder:=xlByRows, _
                                MatchCase:=False, _
                                SearchFormat:=False, _
                                ReplaceFormat:=False
        
        Else
        
        Cells(j, "I").EntireRow.Delete xlUp
        End If
        
        
        Next j
            
        '----------------------------------------------------------------------------------------------------------------------------------------end here
        
        LastRow = Trgtws.Cells(Rows.Count, 1).End(xlUp).Row
        Usdrws = ws.Range("I" & Rows.Count).End(xlUp).Row
        
        ws.Range("A2:N" & Usdrws).Copy
    
    
    If Testcell <> "" Then
    
    
    
    
        Trgtws.Range("A" & LastRow).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
       
    Else
       
        
        Trgtws.Range("A2").PasteSpecial Paste:=xlPasteValues
        Set ob = Trgtws.ListObjects("TINVRead")
        ob.ListRows.Add 1
        
        
    End If
    
    
    End If
    
    
    Next ws
    
    
        
        Application.CutCopyMode = False
        
    
        
        'make column A weekbegining.
        
    Dim r As Long
    
    
    For r = Trgtws.Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
        Trgtws.Range("A" & r).Value = Trgtws.Range("B" & r).Value - Weekday((Trgtws.Range("B" & r).Value), vbUseSystem) + 1
    Next r
    
    
    Trgtws.Range("A2").ClearContents
    '------------------------------------------------------------
          
        
        ActiveWorkbook.Close False
        
        Trgtws.Activate
        Range("A1").Select
        
        'get the subtotals
    
    
    
    
    With Trgtws.ListObjects("TINVRead")
                   
                   .ShowTotals = True
                   .ListColumns("VAT Amount").TotalsCalculation = xlTotalsCalculationSum
                   .ListColumns("Total Invoice Value").TotalsCalculation = xlTotalsCalculationSum
                   .ListColumns("Invoice Value Net").TotalsCalculation = xlTotalsCalculationSum
                   .ListColumns("Invoice Type").TotalsCalculation = xlTotalsCalculationCount
                   .ListColumns("Task").TotalsCalculation = xlTotalsCalculationCount
                   .ListColumns("Comments").TotalsCalculation = xlTotalsCalculationNone
    End With
       
        
        
    ResetSettings:
      'Reset Macro Optimization Settings
        Application.EnableEvents = True
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
        
       
         
        Sheets("INVRead").Protect password:="****", _
        UserInterfaceOnly:=True
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
            , AllowFiltering:=True
        
        End With
      MsgBox "Input Complete"
    End Sub
    Last edited by Davavo; Aug 27th, 2019 at 07:36 AM. Reason: tidy

  7. #7
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    28,203
    Post Thanks / Like
    Mentioned
    470 Post(s)
    Tagged
    47 Thread(s)

    Default Re: Find and Replace any characters in a list of characters

    I cannot see anything in that code that is creating new sheets.
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

  8. #8
    Board Regular
    Join Date
    Aug 2019
    Posts
    76
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Find and Replace any characters in a list of characters

    Sorry for the confusion.

    This is not the script that creates new sheets, it is the script that imports the data. If the data in column "I" is cleaned of characters that are not allowed in new sheets, then my script for creating new sheets will work. So thats why i wanted to put the function to replace illegal characters in there.
    This is the script that creates new sheets.

    Code:
    Option Explicit
    
    Const sname As String = "INVRead" 'change to whatever starting sheet
    Const s As String = "I" 'change to whatever criterion column
    
    
    
    
    Sub columntosheetsINV()
    
    
    Dim wb As Workbook
    Dim sh As Worksheet
    
    
    
    
    Dim d As Object, a, cc&
    Dim p&, i&, rws&, cls&
    Set wb = ThisWorkbook
    Set d = CreateObject("scripting.dictionary")
    
    
    With wb.Sheets(sname)
        rws = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
        cls = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
        cc = .Columns(s).Column
    End With
    
    
    For Each sh In Worksheets
        d(sh.Name) = 1
    Next sh
    
    
    Application.ScreenUpdating = False
    With wb.Sheets.Add(after:=wb.Sheets(sname))
    wb.Sheets(sname).Cells(1).Resize(rws, cls).Copy .Cells(1)
    .Cells(1).Resize(rws, cls).Sort .Cells(cc), 2, Header:=xlYes
    a = .Cells(cc).Resize(rws + 1, 1)
    p = 2
    For i = 2 To rws + 1
        If a(i, 1) <> a(p, 1) Then
            If d(a(p, 1)) <> 1 Then
                Sheets.Add.Name = a(p, 1)
                .Cells(1).Resize(, cls).Copy Cells(1)
                .Cells(p, 1).Resize(i - p, cls).Copy Cells(2, 1)
            End If
            p = i
        End If
    Next i
    Application.DisplayAlerts = False
        .Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    End With
    wb.Sheets(sname).Activate
    
    
    End Sub
    I have no idea how it works. But it works.

  9. #9
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    28,203
    Post Thanks / Like
    Mentioned
    470 Post(s)
    Tagged
    47 Thread(s)

    Default Re: Find and Replace any characters in a list of characters

    Copy the function from post#2 to a module & then change this line
    Code:
    Sheets.Add.Name = a(p, 1)
    to
    Code:
       Sheets.Add.Name = ValidWBName(a(p, 1))
    That way you don't need to change the values in the sheet.
    Last edited by Fluff; Aug 27th, 2019 at 08:05 AM.
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

  10. #10
    Board Regular
    Join Date
    Aug 2019
    Posts
    76
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Find and Replace any characters in a list of characters

    i can just do it this way ....

    i just thought there would be a sytax for an array or list

    Code:
    '-----------------------------------------------------------------------------------------------------------------------------------------starts here        
        For j = Cells(Rows.Count, "I").End(xlUp).Row To 1 Step -1
        On Error Resume Next
        
        If Cells(j, "I") <> "" Then
        
        Cells(j, "I").Replace What:="/", _
                                Replacement:="_", _
                                LookAt:=xlPart, _
                                SearchOrder:=xlByRows, _
                                MatchCase:=False, _
                                SearchFormat:=False, _
                                ReplaceFormat:=False
        Cells(j, "I").Replace What:="\", _
                                Replacement:="_", _
                                LookAt:=xlPart, _
                                SearchOrder:=xlByRows, _
                                MatchCase:=False, _
                                SearchFormat:=False, _
                                ReplaceFormat:=False
        Cells(j, "I").Replace What:=",", _
                                Replacement:="_", _
                                LookAt:=xlPart, _
                                SearchOrder:=xlByRows, _
                                MatchCase:=False, _
                                SearchFormat:=False, _
                                ReplaceFormat:=False
        Cells(j, "I").Replace What:=".", _
                                Replacement:="_", _
                                LookAt:=xlPart, _
                                SearchOrder:=xlByRows, _
                                MatchCase:=False, _
                                SearchFormat:=False, _
                                ReplaceFormat:=False
        Cells(j, "I").Replace What:=":", _
                                Replacement:="_", _
                                LookAt:=xlPart, _
                                SearchOrder:=xlByRows, _
                                MatchCase:=False, _
                                SearchFormat:=False, _
                                ReplaceFormat:=False
        Cells(j, "I").Replace What:=";", _
                                Replacement:="_", _
                                LookAt:=xlPart, _
                                SearchOrder:=xlByRows, _
                                MatchCase:=False, _
                                SearchFormat:=False, _
                                ReplaceFormat:=False
        Else
        
        Cells(j, "I").EntireRow.Delete xlUp
        End If
        
        
        Next j
            
        '----------------------------------------------------------------------------------------------------------------------------------------end here

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •