VBA Code To shift Phone Number One Row Up Next To Name

[raindrop]

Hi !

I want VBA code to shift phone number one row up next column (Column B) to names (Column A).
Herewith I am attaching sample. Can anybody help me?

Thank You.

Raindrop

[Rudi]

Not the most elegant code, but it does the job based on the example you supplied...

Code: Select all

Sub MoveTel()
   Dim rList As Range, rCell As Range, sVal As String
   Set rList = Range("A1").CurrentRegion

   For Each rCell In rList.Columns(1).Cells
      If InStr(rCell.Value, "-") >= 1 Then
         rCell.Offset(-1, 1).Value = rCell
         rCell.Value = ""
      End If
   Next rCell

   For Each rCell In rList.Columns(2).Cells
      If rCell.Value = "" And rCell.Offset(0, -1).Value <> "" Then
         rCell.Value = rCell.Offset(1).Value
      End If
   Next rCell

   For Each rCell In rList.Columns(1).Cells
      If rCell.Value = "" And rCell.Offset(0, 1).Value <> "" Then
         sVal = rCell.Offset(0, 1).Value
         rCell.Offset(-1, 1).Value = rCell.Offset(-1, 1).Value & ", " & sVal
         rCell.Offset(0, 1).Value = ""
      End If
   Next rCell
End Sub

[HansV]

Here is a slightly different approach that loops only once.

Code: Select all

Sub MovePhoneNos()
    Dim lngRow As Long
    Dim lngLastRow As Long
    Dim strPhone As String
    Dim blnAssembling As Boolean
    Application.ScreenUpdating = False
    lngLastRow = Range("A1").End(xlDown).Row
    For lngRow = lngLastRow To 2 Step -1
        If InStr(Range("A" & lngRow).Value, "-") Then
            If blnAssembling = False Then
                strPhone = Range("A" & lngRow).Value
                blnAssembling = True
            Else
                strPhone = Range("A" & lngRow).Value & vbLf & strPhone
            End If
            Range("A" & lngRow).ClearContents
        Else
            If blnAssembling Then
                blnAssembling = False
            End If
            Range("B" & lngRow) = strPhone
        End If
    Next lngRow
    Application.ScreenUpdating = True
End Sub

[Rudi]

I was waiting for your version so I can compare (and learn)
Interesting way of using a boolean switch

[raindrop]

Thank You Very Much... to both of you, Both codes meet my requirement but only problem is that if there is any phone number found in not proper format like 203-451-5511 then it does not work, so please help me there considering numerical value in any format with any character (eg. 2034587810 / 20345821 / *405 / 203-458-7810) code should work.

Thank You.

Raindrop

[HansV]

Assuming that a phone number will always begin with a digit, you can replace the line

Code: Select all

        If InStr(Range("A" & lngRow).Value, "-") Then

in the macro that I posted with

Code: Select all

        If IsNumeric(Left(Range("A" & lngRow).Value, 1)) Then

For Rudi's macro, change

Code: Select all

      If InStr(rCell.Value, "-") >= 1 Then

to

Code: Select all

      If IsNumeric(Left(rCell.Value, 1)) Then

[raindrop]

Solved ! Thank You Very Much Again ! You made me smile. Perfect code Mr. Hans..

Thank You.

Raindrop