I need help with a macro

[KWAMELLH]

I work for Capital One as an account auditor, I get sheets of customer name, phone #s, and account numbers. What I need to do is make a sheet with ONLY account numbers and phone numbers. Most of the time there are many numbers on the account and I only need the last number or column F


Example:

55243583 813-000-1234 813-200-3322 813-333-6622 813-555-5545 813-666-2525

The problem is, I only need the last number dialed which can be anywhere between column b-f. Sometimes my accounts do not convert correctly so the sheet may have moved the numbers over, see example 2:

55243583 813-200-3322 813-333-6622 813-555-5545 813-666-2525

When this happens, i need it to replace B with C-F depending on when the LAST number is. Sometimes the last number is in C. Then I need to to remove all other numbers so it would give me something like example 3:

55243583 813-666-2525


So basically if B is blank then replace with C-F(whereever the last number falls) and clear C-F after replacing B. If B is not blank then it will still be replaced with the last number dial from columns C-F.


I know it doesn't make much sense, but I go through literally 20,000 accounts daily and i have been cutting the last number, replacing C, and clearing the cells. This is very dangerous because I am human and WILL make mistakes or lose place of what I just cut.


Please help me!

 

[KWAMELLH]

Trying to paste once again ..

Sub GetTelNumber()

Dim ShName As Worksheet, StartRow As Long, EndRow As Long, I As Integer, J As Integer, K As Integer
Set ShName = Sheets("YourSheetName") 'Edit sheet name
Application.ScreenUpdating = False
StartRow = 2  ' Change this if needed
EndRow = ShName.Cells(Rows.Count, 1).End(xlUp).Row
For I = StartRow To EndRow
    For J = 6 To 3 Step -1
        If ShName.Cells(I, J) <> "" Then
            ShName.Cells(I, 2) = ShName.Cells(I, J)
'-----------------------------------------------------
'            For K = J To 3 Step -1
'                ShName.Cells(I, K).ClearContents
'            Next K
'            or
            ShName.Range(Cells(I, 3), Cells(I, J)).ClearContents
'-----------------------------------------------------
            Exit For
        End If
    Next J
Next I
Set ShName = Nothing
Application.ScreenUpdating = True
End Sub

you are awesome! this code works great for the most part however I don't think it's fixing all the errors. You are so close and if we could get this to work I don't know how to thank you. Lets look at row 185 for an example of the new problem. Before running the macro C185 has a number in it and it should be moved over to B185 but after running the code it clears the contents completely. Some "B" cells will be empty by default because perhaps we just haven't called the account that day but for the most part column "B" should have a phone # in it. Once I get all phone numbers moved over to "B" then I will the delete all rows where "B" is empty. I could use the code I have now but when I run it on 20,000 accounts we may miss hundreds of numbers. Other examples of the error are shown on row 195, 197, 198... Looks like the code isn't looking at C,D, or E when F is empty. We should look at F first, if empty then E, if empty then D, etc. I'm sure you get what I'm getting at because you've done it perfectly thus far, excel is just being testy

Picture 1 is before picture 2 is after:

 

[jdsouza]

I get these results .. Rows 12, 17, etc have a situation like in row 185 in your uploaded image.

Before

After

Please send the raw file.

 

[JLGWhiz]

this code did work however it did not work on all cells. Excel should look at F first and if F is empty then look at E and it E is empty look at D... etc. bottom line, I need the number furthest right between columns B-F... although my example shows G, G is rarely every filled. The macro also should not touch the date, call type, and duration ( columns H-J). If you can get this to work for us you rock man!!!!

This modified version should do it.

Code:
Sub lastNumb2()
Dim sh As Worksheet, lr As Long, rng As Range, c As Range, lc As Long
Set sh = Sheets(1) 'Edit sheet name
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh.Range("A2:A" & lr)
For Each c In rng
If c.Offset(0, 2) <> "" Then
lc = sh.Cells(c.Row, 8).End(xlToLeft).Column
c.Offset(0, 1) = sh.Cells(c.Row, lc).Value
With sh
.Range(.Cells(c.Row, 3), .Cells(c.Row, lc)).ClearContents
End With
End If
Next
End Sub
Code:

 

[KWAMELLH]

This modified version should do it.

Code:
Sub lastNumb2()
Dim sh As Worksheet, lr As Long, rng As Range, c As Range, lc As Long
Set sh = Sheets(1) 'Edit sheet name
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh.Range("A2:A" & lr)
For Each c In rng
If c.Offset(0, 2) <> "" Then
lc = sh.Cells(c.Row, 8).End(xlToLeft).Column
c.Offset(0, 1) = sh.Cells(c.Row, lc).Value
With sh
.Range(.Cells(c.Row, 3), .Cells(c.Row, lc)).ClearContents
End With
End If
Next
End Sub
Code:

This code worked great for the demo that I have at home. I will run this on 20,000 accounts on Monday and will post the results. Thank you so much.

 

[JLGWhiz]

After some consideration, maybe this version with a safety factor built in would be better. It prevents the loss of all phone numbers in the event there is only one in column B when the clear contents command executes.

Code:
Sub lastNumb3()
Dim sh As Worksheet, lr As Long, rng As Range, c As Range, lc As Long
Set sh = Sheets(1) 'Edit sheet name
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh.Range("A2:A" & lr)
For Each c In rng
If c.Offset(0, 2) <> "" Then
lc = sh.Cells(c.Row, 8).End(xlToLeft).Column
c.Offset(0, 1) = sh.Cells(c.Row, lc).Value
If lc > 2 Then
With sh
.Range(.Cells(c.Row, 3), .Cells(c.Row, lc)).ClearContents
End With
End If
End If
Next
Code:

 

[KWAMELLH]

After some consideration, maybe this version with a safety factor built in would be better. It prevents the loss of all phone numbers in the event there is only one in column B when the clear contents command executes.

Code:
Sub lastNumb3()
Dim sh As Worksheet, lr As Long, rng As Range, c As Range, lc As Long
Set sh = Sheets(1) 'Edit sheet name
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh.Range("A2:A" & lr)
For Each c In rng
If c.Offset(0, 2) <> "" Then
lc = sh.Cells(c.Row, 8).End(xlToLeft).Column
c.Offset(0, 1) = sh.Cells(c.Row, lc).Value
If lc > 2 Then
With sh
.Range(.Cells(c.Row, 3), .Cells(c.Row, lc)).ClearContents
End With
End If
End If
Next
Code:

This code woked on the demo that I have at home, however it did not work properly with the actual file. I looks like it removes the number that is in column B if B is the only number on the row. Maybe if you set it to clear contect of d-f

 

[KWAMELLH]

After some consideration, maybe this version with a safety factor built in would be better. It prevents the loss of all phone numbers in the event there is only one in column B when the clear contents command executes.

Code:
Sub lastNumb3()
Dim sh As Worksheet, lr As Long, rng As Range, c As Range, lc As Long
Set sh = Sheets(1) 'Edit sheet name
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh.Range("A2:A" & lr)
For Each c In rng
If c.Offset(0, 2) <> "" Then
lc = sh.Cells(c.Row, 8).End(xlToLeft).Column
c.Offset(0, 1) = sh.Cells(c.Row, lc).Value
If lc > 2 Then
With sh
.Range(.Cells(c.Row, 3), .Cells(c.Row, lc)).ClearContents
End With
End If
End If
Next
Code:

This code woked on the demo that I have at home, however it did not work properly with the actual file. I looks like it removes the number that is in column B if B is the only number on the row. Maybe if you set it to clear contect of d-f

 

[jdsouza]

OK. Checked your raw file and found the rows giving 'errors' had spaces in the 'empty' cells.

Modified my code to take care of those spaces.

Sub GetTelNumber()

 Dim ShName As Worksheet, StartRow As Long, EndRow As Long, I As Integer, J As Integer, K As Integer
Set ShName = Sheets("YourSheetName") 'Edit sheet name
Application.ScreenUpdating = False
StartRow = 2  ' Change this if needed
EndRow = ShName.Cells(Rows.Count, 1).End(xlUp).Row
For I = StartRow To EndRow
    For J = 6 To 3 Step -1
        If Trim(ShName.Cells(I, J)) <> "" Then
            ShName.Cells(I, 2) = ShName.Cells(I, J)
'-----------------------------------------------------
'            For K = J To 3 Step -1
'                ShName.Cells(I, K).ClearContents
'            Next K
'            or
            ShName.Range(Cells(I, 3), Cells(I, J)).ClearContents
'-----------------------------------------------------
            Exit For
        End If
    Next J
Next I
Set ShName = Nothing
Application.ScreenUpdating = True
End Sub

 

[KWAMELLH]

ok. Checked your raw file and found the rows giving 'errors' had spaces in the 'empty' cells.

Modified my code to take care of those spaces.

sub gettelnumber()

 dim shname as worksheet, startrow as long, endrow as long, i as integer, j as integer, k as integer
set shname = sheets("yoursheetname") 'edit sheet name
application.screenupdating = false
startrow = 2  ' change this if needed
endrow = shname.cells(rows.count, 1).end(xlup).row
for i = startrow to endrow
    for j = 6 to 3 step -1
        if trim(shname.cells(i, j)) <> "" then
            shname.cells(i, 2) = shname.cells(i, j)
'-----------------------------------------------------
'            for k = j to 3 step -1
'                shname.cells(i, k).clearcontents
'            next k
'            or
            shname.range(cells(i, 3), cells(i, j)).clearcontents
'-----------------------------------------------------
            exit for
        end if
    next j
next i
set shname = nothing
application.screenupdating = true
end sub

you are the best!!!! Works like a charm on over 100,000 accounts. Can i save your email for future use?

 

[jdsouza]

You're welcome.


Need views and comments on
Maruti Suzuki Ertiga - Tyre (Tire) Swap Scam ? - YouTube