Tidy up columns

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
1,047
Office Version
  1. 2016
Platform
  1. Windows
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.

VBA Code:
 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

1614347810319.png
 

Some videos you may like

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.

Herakles

Board Regular
Joined
Jul 5, 2020
Messages
53
Office Version
  1. 365
Platform
  1. Windows
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.

VBA Code:
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

Well-known Member
Joined
Apr 22, 2007
Messages
1,047
Office Version
  1. 2016
Platform
  1. Windows
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

Well-known Member
Joined
May 20, 2004
Messages
3,263
Office Version
  1. 2010
Platform
  1. Windows
what do you want it to look like. before and after shot please
 

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
1,047
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

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

Well-known Member
Joined
May 20, 2004
Messages
3,263
Office Version
  1. 2010
Platform
  1. Windows
so you just want phone numbers remaining? delete everything else
 

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
1,047
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

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

Herakles

Board Regular
Joined
Jul 5, 2020
Messages
53
Office Version
  1. 365
Platform
  1. Windows
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?

VBA Code:
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

Well-known Member
Joined
May 20, 2004
Messages
3,263
Office Version
  1. 2010
Platform
  1. Windows
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
VBA Code:
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

Well-known Member
Joined
Apr 22, 2007
Messages
1,047
Office Version
  1. 2016
Platform
  1. Windows
super, I will test both and get back, but wont be until next week
 

Watch MrExcel Video

Forum statistics

Threads
1,127,009
Messages
5,622,149
Members
415,881
Latest member
tasic89

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
Top