Sorting columns with VB

[TFCJamieFay]

Hi all,

I'm working on a bit of code that will sort telephone numbers into the correct columns. I have three columns, Home Number (D), Work Number (E) and Mobile Number (F). The data I have is very messy and the numbers can be in any column, ie mobile numbers in home number column and vice versa.

The logic that I'm trying to use is, if the number starts with a 7 (all numbers have the preceeding zeros removed) then it is a mobile number and should go into column F. If it starts with a 1 or 2 then it should go into column D or E (put it in column D, or if that is already populated with a number begining 1 or 2 then put it in column E).

Also sometimes there can be more than one mobile number, in which case the second mobile number should go into the work number column (E).

This is the code I have so far but it doesn't seem to do anything (sorry I'm not sure how to display it properly!)

Dim MTN, BTN As String
Dim bCell, mCell As Range

lastrow = Range("A" & Rows.Count).End(xlUp).Row

Range("D2:D" & lastrow).Select
For Each cell In Selection
cell.Select
mCell = ActiveCell.Offset(columnoffset:=2, rowoffset:=0).Select
bCell = ActiveCell.Offset(columnoffset:=1, rowoffset:=0).Select
MTN = mCell.Value
BTN = bCell.Value
If Left(cell, 1) = "7" And MTN = "" Then
mCell = cell.Value
ElseIf Left(BTN, 1) = "7" And MTN = "" Then
MTN = BTN
End If
Next

Thanks for any help,

Jay

 

[DonkeyOte]

Not entirely sure I follow -- it looks as though you're iterating column D values for your checks... if so then the point you make re:

If it starts with a 1 or 2 then it should go into column D or E (put it in column D, or if that is already populated with a number begining 1 or 2 then put it in column E).

doesn't make a lot of sense -- ie if the cell.value starts with 1 or a 2 then D will always be full and E would just be a copy of D, no ?

regardless, below should point you in the right direction I think...

Dim MTN, BTN As String
Dim bCell, mCell As Range

lastrow = Range("A" & Rows.Count).End(xlUp).Row

Range("D2:D" & lastrow).Select

For Each cell In Selection
    
    cell.Select
    Set mCell = ActiveCell.Offset(columnoffset:=2, rowoffset:=0)
    Set bCell = ActiveCell.Offset(columnoffset:=1, rowoffset:=0)
    MTN = mCell.Value
    BTN = bCell.Value
    
    Select Case Left(cell, 1)
    
        Case "7"
        
            If MTN = "" Then
                mCell.Value = cell.Value
            Else
                'will overwrite if work number already exists...
                bCell.Value = cell.Value
            End If
        
        Case "1", "2"
            
            bCell.Value = cell.Value
        
        Case Else
            'no logic provided...
            
    End Select
Next

 

[TFCJamieFay]

Thank you very much, that seems to be what I was looking for.