Small snag with non-alphanumeric replacements

[funkykizzy]

Hi all!

I was to change "[" and "]" in the same cell to "-". However, my code does not seem to be able to replace the second bracket in the same string.

My Code:

Sub DataParseSVOC()
'
' Routine for parsing 2008-2009 UATMP SVOC data
'
Dim LR As Long
Dim Itm As Long
Dim MyCount As Long
Dim vCol As Long
Dim ws As Worksheet
Dim MyArr As Variant
Dim MyArr2 As Variant
Dim vTitles As String
Dim aFind As Variant
Dim aReplace As Variant
aFind = Array("[", "]")
aReplace = Array("-", "-")
 
Application.ScreenUpdating = False
 
'Column to evaluate from, column A = 1, B = 2, etc.
   vCol = 3
 
'Sheet with data in it
   Set ws = Sheets("SVOC")
 
'Range where titles are across top of data, as string, data MUST
'have titles in this row, edit to suit your titles locale
    vTitles = "A1:M1"
 
'Spot bottom row of data
   LR = ws.Cells(ws.Rows.Count, vCol).End(xlUp).Row
 
'Get a temporary list of unique values from column vCol
      ws.Columns(vCol).SpecialCells(xlConstants).AdvancedFilter _
        Action:=xlFilterCopy, CopyToRange:=ws.Range("P1"), Unique:=True
 
'Create a separate list for worksheet tab names and remove special characters
      ws.Columns(vCol).SpecialCells(xlConstants).AdvancedFilter _
        Action:=xlFilterCopy, CopyToRange:=ws.Range("Q1"), Unique:=True
 
      ws.Columns("Q:Q").Replace What:=aFind, Replacement:=aReplace, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
'Sort the temporary lists
    ws.Columns("P:P").Sort Key1:=ws.Range("P2"), _
        Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
 
    ws.Columns("Q:Q").Sort Key1:=ws.Range("Q2"), _
        Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
'Put list into an array for looping
'(values cannot be the result of formulas, must be constants)
    MyArr = Application.WorksheetFunction.Transpose(ws.Range("P1:P" _
        & Rows.Count).SpecialCells(xlCellTypeConstants))
 
    MyArr2 = Application.WorksheetFunction.Transpose(ws.Range("Q1:Q" _
        & Rows.Count).SpecialCells(xlCellTypeConstants))
'clear temporary worksheet list
    ws.Range("P:P").Clear
    ws.Range("Q:Q").Clear
'Turn on the autofilter, one column only is all that is needed
    ws.Range(vTitles).AutoFilter
'Loop through list one value at a time
'The array includes the title cell, so we start at the second value in the array
'In case values are numerical, we convert them to text with ""
    For Itm = 2 To UBound(MyArr)
        ws.Range(vTitles).AutoFilter Field:=vCol, Criteria1:=MyArr(Itm) & ""
 
        If Not Evaluate("=ISREF('" & MyArr(Itm) & "'!A1)") Then    'create sheet if needed
            Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = MyArr2(Itm) & ""
        Else                                                      'clear sheet if it exists
            Sheets(MyArr2(Itm) & "").Move After:=Sheets(Sheets.Count)
            Sheets(MyArr2(Itm) & "").Cells.Clear
        End If
 
        ws.Range("A" & Range(vTitles).Resize(1, 1) _
            .Row & ":A" & LR).EntireRow.Copy Sheets(MyArr2(Itm) & "").Range("A1")
 
        ws.Range(vTitles).AutoFilter Field:=vCol
        MyCount = MyCount + Sheets(MyArr2(Itm) & "") _
            .Range("A" & Rows.Count).End(xlUp).Row - 1
        Sheets(MyArr2(Itm) & "").Columns.AutoFit
    Next Itm
 
'Cleanup
    ws.AutoFilterMode = False
    MsgBox "Rows with data: " & (LR - 1) & vbLf & "Rows copied to other sheets: " _
                & MyCount & vbLf & "Hope they match!!"
Application.ScreenUpdating = True
End Sub

And the result:

Original = Cyclopenta[cd]pyrene
Macro Result = Cyclopenta-cd]pyrene
Desired = Cyclopenta-cd-pyrene

Any thoughts/suggestions!!

Thank you so much in advance!

 

[funkykizzy]

EUREKA!!! That finally worked!

I tried just about everything BUT setting the worksheet. I have the replace code called in a set of larger code and I figured it would simply act on the active worksheet...guess not.

Thank you oh so much! I really appreciate it!