View Full Version : Need Help: reorganizing exported info
teachingkids
11-04-2008, 10:24 AM
I have a range of information exported from another app that I need to reorganize.
In each row there are between 1 and 4 phone numbers in columns D-G with various contact information in columns A-C. I need the information arranged so that there is only one phone number per row.
So if there are are phone numbers in columns D, E, and G with a blank in F, I need to have 3 rows, each with only one phone number and all the same contact information from columns A-C.
I've taken some VB but this is beyond me. Any help would be greatly appreciated!
Bob Phillips
11-04-2008, 10:33 AM
Public Sub ProcessData()
Dim i As Long
Dim LastRow As Long
Dim j As Long
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = LastRow To 2 Step -1
For j = 7 To 5 Step -1
If .Cells(i, j).Value <> "" Then
.Rows(i + 1).Insert
.Cells(i, "A").Resize(, 3).Copy .Cells(i + 1, "A")
.Cells(i, j).Copy .Cells(i + 1, "D")
End If
Next j
.Cells(i, "E").Resize(, 3).ClearContents
If .Cells(i, "D").Value = "" Then Rows(i).Delete
Next i
End With
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
teachingkids
11-04-2008, 10:46 AM
Wow! That was a quick reply. Thank you so much!
One more question, can you show me how to delete the rows that contain the same phone numbers?
Bob Phillips
11-04-2008, 11:09 AM
This deletes themm if column A and column D match
Public Sub ProcessData()
Dim i As Long
Dim LastRow As Long
Dim j As Long
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = LastRow To 2 Step -1
For j = 7 To 5 Step -1
If .Cells(i, j).Value <> "" Then
.Rows(i + 1).Insert
.Cells(i, "A").Resize(, 3).Copy .Cells(i + 1, "A")
.Cells(i, j).Copy .Cells(i + 1, "D")
End If
Next j
.Cells(i, "E").Resize(, 3).ClearContents
If .Cells(i, "D").Value = "" Then Rows(i).Delete
Next i
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = LastRow To 2 Step -1
If .Cells(i, "A").Value = .Cells(i - 1, "A").Value And _
.Cells(i, "D").Value = .Cells(i - 1, "D").Value Then
.Rows(i).Delete
End If
Next i
End With
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
teachingkids
11-04-2008, 01:38 PM
That didn't work out.
Bob Phillips
11-04-2008, 02:09 PM
Care to share with us?
teachingkids
11-04-2008, 02:12 PM
Oh I'm sorry. It rearranged the data but did not delete the duplicates. Does that help?
And thanks again for all you're doing for me! This is going to save me so much time throughout the year. I'm exporting the phone numbers from our school database and entering them in our automated calling system. I need to update the numbers once a month and with 6000 numbers....well this would be a waste of time to do one at a time.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.