script to convert all characters in excel sheet to A.

bfuchs
bfuchs used Ask the Experts™
on
Hi Experts,
Looking for a script that will perform the following
open a given spreadsheet, loop thru all columns/rows and replace all data as follows. (except for first row)
for every character found, replace it with letter A
for every digit found, replace it with 1
should leave any special character like slashes or space intact.
Thanks
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Sr. Project Manager
Commented:
Here is a simple script that would work.. Give it a spin and let me know.

Sub ReplaceAll()
      
      Dim LastRow As Long
      With ActiveSheet
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
      End With

      Dim LastCol As Integer
      With ActiveSheet
            LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
      End With
      
      For j = 1 To LastCol
            For i = 2 To LastRow
                  replStr = Cells(i, j)
                  
                  For n = 1 To Len(replStr)
                        replLtr = Mid(replStr, n, 1)
                        If Asc(replLtr) >= 65 And Asc(replLtr) <= 90 Then
                              Mid(replStr, n, 1) = "A"
                        End If
                        If Asc(replLtr) >= 97 And Asc(replLtr) <= 122 Then
                              Mid(replStr, n, 1) = "A"
                        End If
                        If Asc(replLtr) >= 48 And Asc(replLtr) <= 57 Then
                              Mid(replStr, n, 1) = "1"
                        End If
                  Next
                  Cells(i, j) = replStr
            Next
      Next
End Sub
Sam JacobsDirector of Technology Development, IPM
Commented:
You may wish to try this:

Option Explicit

Function GetFile(startPath As String, fileTypes As String)
 
With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = False
    'Filter to selected file types - sample format:
    ' "Excel Files", "*.xslx; *.xlsm; *.xls" | "All Files", "*.*"
        .Filters.Clear
        If InStr(fileTypes, "|") < 1 Then
        Dim aFilter() As String
        aFilter = Split(fileTypes, ",")
        .Filters.Add Trim(aFilter(0)), Trim(aFilter(1))
    Else
        Dim aExtensions() As String
        aExtensions = Split(fileTypes, "|")
        Dim idx As Integer
        For idx = 0 To UBound(aExtensions)
            aFilter = Split(Trim(aExtensions(idx)), ",")
            .Filters.Add Trim(aFilter(0)), Trim(aFilter(1))
        Next
    End If
    'Show the dialog box
    If .Show = -1 Then
        GetFile = .SelectedItems.Item(1)
    Else
        GetFile = ""
    End If
End With
 
End Function

Function ReplaceCell(cellValue As String)

    Dim RE As Object
    Set RE = CreateObject("VBScript.RegExp")

    RE.ignoreCase = True
    RE.Global = True

    ' replace characters
    RE.Pattern = "[A-Za-z]"
    cellValue = RE.Replace(cellValue, "A")
    ' replace numbers
    RE.Pattern = "[0-9]"
    cellValue = RE.Replace(cellValue, "1")
    
    ReplaceCell = cellValue
End Function

Sub Main()

Dim cell As Range

Dim strFile As String
    strFile = GetFile(Application.ActiveWorkbook.Path, "Excel Files, *.xslx; *.xlsm; *.xls")
    If strFile = "" Then End
    Workbooks.Open strFile
    Application.ScreenUpdating = False
    For Each cell In ActiveSheet.UsedRange
        If cell.Row > 1 Then
            cell.Value = ReplaceCell(cell.Value)
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Open in new window

Both seem to work.
Thank you!

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial