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!

 

[excel_help_101]

is there any way you could show what the format looks like in the spreed sheet. high light the cells you need to change... 1's and 0's are good i dont need any account numbers lol

 

[JLGWhiz]

Try this on a copy of your file before you try it on the original. Data deleted by code cannot be recovered with the undo command. This procedure should look at column C and if column C is not blank, then it will look for the last column in that row with data and will replace the data in Column B with the data from the last column of the row.

Code:
Sub lastNumb()
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, Columns.Count).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]

is there any way you could show what the format looks like in the spreed sheet. high light the cells you need to change... 1's and 0's are good i dont need any account numbers lol

 

[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!

I also need to have the date column untouched by the macro... see the picture below and its the exact layout of how things are now and how I need the account # and phone to be. I did not bother showing an example of the date because after the macro i can simply move the column over. No biggie.

 

[jdsouza]

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

 

[KWAMELLH]

Try this on a copy of your file before you try it on the original. Data deleted by code cannot be recovered with the undo command. This procedure should look at column C and if column C is not blank, then it will look for the last column in that row with data and will replace the data in Column B with the data from the last column of the row.

Code:
Sub lastNumb()
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, Columns.Count).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 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!!!!

 

[KWAMELLH]

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

Thanks for your quick reply; however, I'm getting a compile error: see the picture.

 

[jdsouza]

Sub GetTelNumber()Dim ShName As Worksheet, StartRow As Long, EndRow As Long, I As Integer, J As Integer, K As IntegerSet ShName = Sheets("YourSheetName") 'Edit sheet nameApplication.ScreenUpdating = FalseStartRow = 2 ' Change this if neededEndRow = ShName.Cells(Rows.Count, 1).End(xlUp).RowFor 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 JNext ISet ShName = NothingApplication.ScreenUpdating = TrueEnd Sub</pre>

 

[jdsouza]

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