Removing Special Characters From Certain Columns Loop

[tripodgod]

Hello!

I am a novice when it comes to VBA so please excuse any amateur mistakes...

I have the below code to remove special characters from a sheet called "NewUpload" based on another sheet, "Header_List". "Header_List" contains all the headers in "NewUpload" with additional information against each one. For example column C in "Header_List" is called "Remove Characters?" which if set to "Yes" will remove certain characters from the matching column in "NewUpload"; as specified in the function "RemoveSpecialChars" (which I found online).

Public Sub RemoveCharactersVer2()

Dim strCell, strCellNew, strHeader, strCol As String
Dim cell, cell2, aCell, rng As Range
Dim col As Long


'Find last row of header list
lastrow = Sheets("Header_List").Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'Find last row of new upload data
lastrow2 = Sheets("NewUpload").Range("B:B").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    'Loop through headers
    For Each cell In Sheets("Header_List").Range("A2:A" & lastrow)
        Sheets("Header_List").Activate
        Sheets("Header_List").Range("A2").Activate
        'If Remove Characters? option set then..
        If cell.Offset(0, 2).Value = "Yes" Then
            'Set strHeader to Related Header code
            strHeader = cell.Offset(0, 1)
            Sheets("NewUpload").Activate
            Sheets("NewUpload").Range("A2").Activate
            'Find column that matches Related Header
            Set aCell = Sheets("NewUpload").Range("A1:BH1").Find(What:=strHeader, LookIn:=xlValues, LookAt:=xlWhole, _
                        MatchCase:=False, SearchFormat:=False)
            'Set col as column number
            col = aCell.Column
            'Set strCol as column letter
            strCol = Col_Letter(col)
            'Set rng as column range *2:*lastrow
            Set rng = Sheets("NewUpload").Range(strCol & "2:" & strCol & lastrow2)
                'For each cell2 in above range..
                For Each cell2 In rng
                
                    Sheets("NewUpload").Range(strCol & "2").Activate
                    'Set strCell as the current cell address
                    strCell = cell.Address
                    'Set strCellNew as character removed version of string
                    strCellNew = RemoveSpecialChars(Sheets("NewUpload").Range(strCell))
                    'Change cell value to character removed version of string
                    cell.Value = strCellNew
                
                Next cell2
    
    
        Else
        GoTo Skip
        End If
Skip:
    Next cell
End Sub

However when this code is run it replaces the special characters as expected but it is also replacing the value in column A of "Header_List" to the first replaced value in the "NewUpload" sheet. I password protected the sheet to see where it crashed and it crashed at:

cell.Value = strCellNew

I spent many hours trying to work out why it is doing this (that is why I am activating cells above - this wasn't originally there) and I just can't see it!

Thank you in advance!

 

[StephenCrump]

However when this code is run it replaces the special characters as expected but it is also replacing the value in column A of "Header_List" to the first replaced value in the "NewUpload" sheet.

Just a very quick observation ....

It sound like you don't want the values in Column A of "Header List" to be changed?

But in this nested loop, whilst you're looping through each cell2, you're referencing cell rather than cell2. cell is defined previously as Column A of "Header List", so the line in red will write to that column.

For Each [U][B]cell2[/B][/U] In rng
    Sheets("NewUpload").Range(strCol & "2").Activate
    'Set strCell as the current cell address
    strCell = [U][B]cell[/B][/U].Address
    'Set strCellNew as character removed version of string
    strCellNew = RemoveSpecialChars(Sheets("NewUpload").Range([U][B]strCell[/B][/U]))
    'Change cell value to character removed version of string
[B][COLOR=#ff0000]    cell.Value = strCellNew[/COLOR][/B]
Next [U][B]cell2[/B][/U]

 

[tripodgod]

Hi StephenCrump

wow how did I miss that. Thank you for pointing that out!

Yesterday I added "On Error Resume Next" to the nested loop (and the code did what I wanted it to) like this:

For Each cell2 In rng                
       Sheets("NewUpload").Range(strCol & "2").Activate
       'Set strCell as the current cell address
       strCell = cell2.Address
       'Set strCellNew as character removed version of string
       strCellNew = RemoveSpecialChars(Sheets("NewUpload").Range(strCell))
       'Change cell value to character removed version of string
[B]       On Error Resume Next[/B]
       cell2.Value = strCellNew
                    
Next cell2

If I take that line out I get an "Object Variable or With block variable not set message at:

col = aCell.Column

Now it isn't the end of the world as I can leave the On Error Resume Next where it is (and thanks to you it has stopped trying to write to "Header_List") but it bugs me that something is still wrong with the code. It crashes as col = 51 which is a column of Ingredients (nothing in the column though). Very weird indeed!

Thank you again for your help

 

[StephenCrump]

The error means that your .Find hasn't worked, so aCell will be Nothing, and therefore referencing aCell.Column will produce an error (with a not very helpful error message!)

You should use On Error Resume Next only sparingly, otherwise your code could be erroring in many ways and producing incorrect results, and you wouldn't know it.

In general terms, here's how I'd do the .Find

On Error Resume Next
Set aCell = Sheets("NewUpload").Range("A1:BH1").Find(What:=strHeader, LookIn:=xlValues, LookAt:=xlWhole, _
    MatchCase:=False, SearchFormat:=False)
On Error GoTo 0

If aCell Is Nothing Then
    'Find didn't work!  Do something?
Else
    col = aCell.Column
    '....
End If

I hope you can adapt this to your code?

 

[tripodgod]

Ah that makes sense now. I was able to identify a typo in the Header_List causing the problem (missing S from the end of a word!) and now it goes through without error.

I adapted my code using your suggestion and it works perfectly so once again a massive thank you for your help with this. I am still learning VBA but I hadn't thought to handle an occasion where my search string wasn't found. Lesson learnt!

        If cell.Offset(0, 2).Value = "Yes" Then
            'Set strHeader to Related Header code
            strHeader = cell.Offset(0, 1)
            Sheets("NewUpload").Activate
            Sheets("NewUpload").Range("A2").Activate
            
            On Error Resume Next
            'Find column that matches Related Header
            Set aCell = Sheets("NewUpload").Range("A1:BH1").Find(What:=strHeader, LookIn:=xlValues, LookAt:=xlWhole, _
                        MatchCase:=False, SearchFormat:=False)
            On Error GoTo 0
                If aCell Is Nothing Then
                    MsgBox strHeader & " not found!"
                Else
                
                    'Set col as column number
                    col = aCell.Column
                    'Set strCol as column letter
                    strCol = Col_Letter(col)
                    'Set rng as column range *2:*lastrow
                    Set rng = Sheets("NewUpload").Range(strCol & "2:" & strCol & lastrow2)
                        'For each cell2 in above range..
                        For Each cell2 In rng
                        
                            Sheets("NewUpload").Range(strCol & "2").Activate
                            'Set strCell as the current cell address
                            strCell = cell2.Address
                            'Set strCellNew as character removed version of string
                            strCellNew = RemoveSpecialChars(Sheets("NewUpload").Range(strCell))
                            'Change cell value to character removed version of string
                            cell2.Value = strCellNew
                            
                        Next cell2
                End If
    
        Else
        GoTo Skip
        End If