Tidy up columns

[Sharid]

I want to clean up some columns with Vba. I currently use this and it works fine more the most part, if the columns has text and numbers then it does not remove the item.

 Dim lastrow As Integer, i As Integer
            Set wb = ThisWorkbook
                With wb.Sheets("Data")
                lastrow = .Cells(.Rows.Count, "c").End(xlUp).Row
                    For i = 2 To lastrow
      '''phone numbers
            If Not (Sheet9.Range("c" & i).Value Like "*#*#*#*#*") Then Sheet9.Range("c" & i).Value = "-"
            If Not (Sheet9.Range("d" & i).Value Like "*#*#*#*#*") Then Sheet9.Range("d" & i).Value = "-"
            If Not (Sheet9.Range("e" & i).Value Like "*#*#*#*#*") Then Sheet9.Range("e" & i).Value = "-"
            
            If Not (Sheet9.Range("c" & i).Value Like "**#") Then Sheet9.Range("c" & i).Value = "-"
            If Not (Sheet9.Range("d" & i).Value Like "**#") Then Sheet9.Range("d" & i).Value = "-"
            If Not (Sheet9.Range("e" & i).Value Like "**#") Then Sheet9.Range("e" & i).Value = "-"

         .Range("C" & i).Value = Replace(.Range("C" & i).Value, "Call", "")
         .Range("D" & i).Value = Replace(.Range("D" & i).Value, "Call", "")
         .Range("E" & i).Value = Replace(.Range("E" & i).Value, "Call", "")
     Next i
    End With

Results in red are not removing, all the phone numbers have the word "Call" which i can remove, however the other items have too many variables. I will not be able to work each one out the same as removing the word "Call"

PS. Some phone numbers have a "+" at the front e.g. +111222333

 

[Herakles]

This was taken from
How to remove alpha characters from cells in Excel?
and should help you. I had to add in variable declarations as they had been missed out.

Public Sub subRemoveAlpha()
'Updateby20131129
Dim Rng As Range
Dim WorkRng As Range
Dim xTitleId As String
Dim xOut As String
Dim i As Integer
Dim xTemp As String
Dim xStr As String

On Error Resume Next
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
For Each Rng In WorkRng
    xOut = ""
    For i = 1 To Len(Rng.Value)
        xTemp = Mid(Rng.Value, i, 1)
        If xTemp Like "[a-z.]" Or xTemp Like "[A-Z.]" Then
            xStr = ""
        Else
            xStr = xTemp
        End If
        xOut = xOut & xStr
    Next i
    Rng.Value = xOut
Next
End Sub

 

[Sharid]

thanks, for this, however I think this will leave any numbers as some cells have dates so 1st January 2021 will become 1 2021 if I am reading this correct. could be wrong not tested it yet.

 

[diddi]

what do you want it to look like. before and after shot please

 

[Sharid]

I am not able to give a screen shot as the file is not at home, However if you look at the above image all text in red is gone and replaced with a hyphen on phone numbers remain. some phone numbers have the word "Call" in frott or will have a "+" the "Call" I can remove. the "+" i do not need to remove.

A lot of junk text ends up in these columns and i have to manually clearn on, currently my above code does most of the cleaning, just not the dates or anything with a mixure of text+number

 

[diddi]

so you just want phone numbers remaining? delete everything else

 

[Sharid]

YES, Only phone numbers in columns C,D,E

 

[Herakles]

This should remove the dates although they are not stored as dates but as text.

Could the dates be stored like '1st Jan 2021' in which the case the code will need to be enhanced to take this into account.

Could there be a date and a valid phone number in the same cell?

Public Sub subRemoveAlpha()
Dim Rng As Range
Dim WorkRng As Range
Dim xTitleId As String
Dim xOut As String
Dim i As Integer
Dim xTemp As String
Dim xStr As String

On Error Resume Next
xTitleId = "Select range."
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
For Each Rng In WorkRng
    xOut = ""
    If fncIsValueADate(Rng.Value) Then
        Rng.Value = ""
    Else
        For i = 1 To Len(Rng.Value)
            xTemp = Mid(Rng.Value, i, 1)
            If xTemp Like "[a-z.]" Or xTemp Like "[A-Z.]" Then
                xStr = ""
            Else
                xStr = xTemp
            End If
            xOut = xOut & xStr
        Next i
        Rng.Value = xOut
    End If
Next
End Sub

Private Function fncIsValueADate(varValue As Variant) As Boolean
Dim i As Integer
Dim arrMonths

    arrMonths = Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")
    
    For i = 0 To UBound(arrMonths)
        If InStr(1, varValue, arrMonths(i), vbTextCompare) > 0 Then
            fncIsValueADate = True
            Exit Function
        End If
    Next i
    
End Function

 

[diddi]

heres a novel approach to try. it needs a bit of a tweek to get the leading "0" in some numbers, but it seems good otherwise

Sub CleanUp()
    'Copies phone numbers to new column 4 to the right for testing purposes
    Dim lastrow As Integer, Row As Integer, WB As Worksheet
    Dim Col As Long, Temp As String, Row2 As Long
    Set WB = Sheets("Data")
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    With WB
        For Col = 3 To 5
            lastrow = .Cells(.Rows.Count, "C").End(xlUp).Row
            For Row = 2 To lastrow
                Temp = .Cells(Row, 3)
                Temp = Replace(Temp, " ", "")
                For Row2 = 1 To Len(Temp) - 9
                    If Val(Mid(Temp, Row2)) > 1000000 Then
                        .Cells(Row, Col + 4) = Val(Mid(Temp, Row2))
                        Exit For
                    End If
                Next Row2
            Next Row
        Next Col
    End With
                   
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

 

[Sharid]

super, I will test both and get back, but wont be until next week