Small snag with non-alphanumeric replacements

funkykizzy

New Member
Joined
Nov 2, 2010
Messages
22
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:
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!
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
Anyone? Please? I hate to beg, but I was hoping this was something small that I had overlooked...

Thank you!
 
Upvote 0
Hi

Code:
Dim aFind As Variant
Dim aReplace As Variant

aFind = Array("[", "]")
aReplace = Array("-", "-")
 
' ...
      ws.Columns("Q:Q").Replace What:=[COLOR=red][B]aFind[/B][/COLOR], Replacement:=[B][COLOR=red]aReplace[/COLOR][/B], LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False

The replace method of the range object replaces a string with another string, not an array with another array.

You have to loop through the arrays and use .Replace() for each of the string pairs.
 
Upvote 0
Separating all the other stuff you're doing, you could have a small sub that does the find and replace on a range:

Code:
Sub ReplaceBrackets(r As Range)
    Dim cell        As Range
 
    For Each cell In r
        With cell
            If Not .HasFormula(.Cells) And VarType(.Value) = vbString Then
                If .Value Like "*
[*]*" Then
                    .Value = Replace(Replace(.Value, "[", "-"), "]", "-")
                End If
            End If
        End With
    Next cell
End Sub

E.g.,
Code:
    ReplaceBrackets Range("A1:A10")
 
Upvote 0
Hi again!

I gave your suggestion a try and I got a type mismatch error. So I did a bunch of debugging but I still couldn't get the code to run smoothly. For now I might just write everything out each character at a time to meet my deadline, but in the future it would be nice to specify an array of characters to be replaced with another array of characters in the cell contents of a particular row.

Cheers!!
 
Upvote 0
Hi

As I said you could also loop through the arrays:

Code:
...
Dim aFind As Variant
Dim aReplace As Variant
[COLOR=red]Dim j As Long[/COLOR]
 
aFind = Array("[", "]")
aReplace = Array("-", "-")
 
' ...
      
[COLOR=red]For j = LBound(aFind) To UBound(aFind)
[/COLOR]      ws.Columns("Q:Q").Replace What:=aFind[COLOR=red](j)[/COLOR], Replacement:=aReplace[COLOR=red](j)[/COLOR], LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
[COLOR=red]Next j
[/COLOR]
 
Upvote 0
Thanks PGC!

That is exactly what I am currently working on (well, until I was interrupted by another project, but I am back at it now).

I will let you know if I can get it to work out.
 
Upvote 0
Still getting an error. This time it is Run-Time 424 "Object Required". I am trying to debug and see if I am not calling this code right or if I failed to identify something...but still no luck.
 
Upvote 0
Maybe this sub helps your debug.

It replaces all "[" and "]" with "-" in column Q of the active worksheet.

Try and see if you get any error:

Code:
Sub Test()
Dim ws As Worksheet
Dim aFind As Variant
Dim aReplace As Variant
Dim j As Long
 
Set ws = ActiveSheet
aFind = Array("[", "]")
aReplace = Array("-", "-")
            
For j = LBound(aFind) To UBound(aFind)
      ws.Columns("Q:Q").Replace What:=aFind(j), Replacement:=aReplace(j), LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
Next j
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,236
Members
448,555
Latest member
RobertJones1986

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