Clear data

[Panoos64]

Hi all, I would like to clear any symbols the word Undefined and once the number using vba. Please note that these data are in col. "A" and the rows are 3000+. The numbers are not the same but more than 40. e.g. 101003, 101004, 203001 e.t.c. The 1st schedule, shows the original data and the 2nd the expected result.

Many thanks in advance

<colgroup><col width="63"></colgroup><tbody>
[TD="width: 63"] 1st: ~101003-~101003**Undefined**


2nd:
101003
[/TD]

</tbody>

 

[gallen]

Are the only symbols to be replaced *,~ and - ?

Is the number always 6 digits long?

 

[L. Howard]

If the data is consistent throughout the column A try =MID(A2,2,6) and fill down.

Where the first seven characters are always in this format ~101003

Howard

 

[gallen]

This code works assuming number is always 6 digits long and is the first 6 digit number in the cell:

(Paste into code window of sheet and run Cleansheet sub)

Sub CleanSheet()


Dim l As Long
    
    'Assuming data starts in row2:
    For l = 2 To Range("A" & Rows.Count).End(xlUp).Row
        If Len(Range("A" & l)) > 0 Then
            Range("A" & l) = CleanCell(Range("A" & l))
        End If
    Next l
    
End Sub


Function CleanCell(s As String) As String

Dim sClean As String
Dim i As Integer
    'assuming number is always 6 digits
    For i = 1 To Len(s)
        If IsNumeric(Mid(s, i, 1)) Then
            If IsNumeric(Mid(s, i, 6)) Then
                CleanCell = Mid(s, i, 6)
                Exit Function
            End If
        End If
    Next i
    
End Function

 

[Panoos64]

Thank you gallen for your respond. The symbols are right as you wrote above, but the numbers, some of them are 6 digits, but some 5 digits.

Thanks once again.
Hv a nice day

 

[gallen]

Change the function to search for 6 and 5 digit numbers:

Function CleanCell(s As String) As String


Dim sClean As String
Dim i As Integer
    'assuming number is always 6 digits
    For i = 1 To Len(s)
        If IsNumeric(Mid(s, i, 1)) Then
            If IsNumeric(Mid(s, i, 6)) Then
                CleanCell = Mid(s, i, 6)
                Exit Function
            ElseIf IsNumeric(Mid(s, i, 5)) Then
                CleanCell = Mid(s, i, 5)
                Exit Function
            End If
        End If
    Next i
    
End Function

 

[Panoos64]

Thank you gallen. It works but it cleans except symbols, any other words that existing in col. "A". Just i need to clean the symbols as i specified.
However thanks once again for your support.

Hv a nice day

 

[gallen]

Due to a slight language barrier, could you please, as per forum guidelines, show your data how it is now and how you want it to look. Thank you.

 

[Panoos64]

Hi gallen, Please see below extract of original data, data after code's run and the expected result. As i told you the code run perfect, but you should determine to clean only the symbols, ~-* the word, Undefined and where the numbers are duplicate with 5 or 6 digits, should clean the one.

However thanks once again for your support.
Hv a nice day

ORIGINAL DATA

90202005 REFRESHMENTS CATEGORY

90202010 WINES CATEGORY

90202015 BEERS LOCAL / IMPORTED CATEGORY

~101003-~101003**Undefined**

~10105-~10105**Undefined**

<tbody>
</tbody>

CODE'S RESULT (after run)

10105- <tbody> [TD="class: xl65"] EXPECTED RESULT

<tbody>
[TD="class: xl65"]90202005[/TD]

[TD="class: xl65"]90202010[/TD]

[TD="class: xl65"]90202015[/TD]

[TD="class: xl65"]101003-[/TD]

[TD="class: xl65"]90202005 REFRESHMENTS CATEGORY[/TD]

[TD="class: xl65"]90202010 WINES CATEGORY[/TD]

[TD="class: xl65"]90202015 BEERS LOCAL / IMPORTED CATEGORY[/TD]

[TD="class: xl65"]101003[/TD]

[TD="class: xl65"]10105[/TD]

</tbody>

[/TD]

</tbody>

 

[gallen]

OK if this isn't it you may need to ask someone else. As the goalposts have changed a few times I'm hoping this does what you need:

Alter the array to remove any string values you see fit:

Please copy all this into the sheet code module. All elements have been amended

Function CleanCell(s As String) As String


Dim aRemove()
Dim i As Integer, x As Integer
Dim sClean As String
Dim lNumber As Long
    
    'Parse out number
    lNumber = GetNumber(s)
    
    'Search for and remove any repeated instances of number
    sClean = RemoveRepeatedNos(s, CStr(lNumber))
    
    'First create array of all string values to be removed
    aRemove = Array("-", "~", "*", "Undefined") ' In this array enter all string characters you want removing
    
    'Now remove all unwanted characters
    For i = 0 To UBound(aRemove)
        sClean = Replace(sClean, aRemove(i), "")
    Next i
    
    'Return cleaned string to cell
    CleanCell = sClean
    
End Function


Private Function RemoveRepeatedNos(s As String, sNumber As String) As String


Dim iFirst As Integer
Dim s1 As String
    
    iFirst = InStr(1, s, sNumber)
   
    s1 = Replace(s, sNumber, "")
    
    If iFirst = 1 Then
        s1 = sNumber & s1
    Else
        s1 = Left(s1, iFirst - 1) & sNumber & Right(s1, Len(s1) - iFirst + 1)
    End If
    RemoveRepeatedNos = s1
End Function


Private Function GetNumber(s As String) As Long


Dim i As Integer, x As Integer
    
    For i = 1 To Len(s)
        If IsNumeric(Mid(s, i, 1)) Then
            x = i + 1
            Do Until IsNumeric(Mid(s, x, 1)) = False
                
                x = x + 1
            Loop
            GetNumber = Mid(s, i, x - i)
            Exit Function
        End If
    Next i
    
End Function


Sub CleanSheet()
Dim c As Range
    
    'Assuming data starts in row2:
    For Each c In Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
        c.NumberFormat = "@" 'Set cell as text to stop any leading zeros being removed
        If Len(c) > 0 Then
            c = CleanCell(c.Text)
        End If
    Next c
    
End Sub

Ensure you run the 'Cleansheet' sub