Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 80
Default Compare 4 columns and copy

Hello all,

In sheet1 Col.A I have many Zip codes and In sheet2 Col.A,B,C,D I have many
Zip codes also and in Col.E I have Phone numbers. How can I match Sheet1 Col.
A cell A:1 with sheet2 Col.A,B,C,D and If matches I would like to Copy
corresponding Col.E cell to sheet1 Col.B and look for the next one below and
then to the end of the column then the next column and paste it to sheet1
corresponding row. Since I am interested in getting sheet2 Col.E matches I
will not neet to have duplicates, for example in the sample below I'll get
cell E:1 copied to sheet1 because A:1 matches and next time If B:1 had 94597
I wouldn't need to have E:2 because I already have it from Row.A.
I hope I explained right. And if I get dups. in result there will be no
problem I will delete them manually.

Thank you in advance.


Ex.

In Sheet1
Col.A
94597
94593
:
:

In Sheet2

Col.A Col.B Col.C Col.D Col.E

94597 94600 94591 96523 925 921
94598 94597 94597 97863 925 933
94599 94594 94597 35624 926 922
94597 94593 94565 94597 925 932


The result would be:

In sheet1

Col.A Col.B Col.C Col.D Col.E Col.F Col.G Col.H
94597 925 921 925 932 925 933 925 933 925 922 926 932
94593 925 932

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...excel/200708/1

  #2   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 3,365
Default Compare 4 columns and copy

I believe you'll find that this code will work to accomplish the task,
without duplicated phone numbers on any row also.
I recommend making a copy of your workbook to do the testing in - since if
you make a change to the code (or not) that ends up causing existing entries
to be overwritten, they'll be gone forever. So make a copy of the workbook
and then ...

To put the code to work, first put it into your workbook:
Press [Alt]+[F11] to open the Visual Basic (VB) Editor. In the VB Editor
use its menu toolbar to choose Insert | Module. The copy the code and paste
it into the code module presented to you. Make any changes you need to to
the Const values I've marked with ' change? to reflect the actual names and
setup of your two worksheets. Close the VB Editor. To try it out, use Tools
| Macro | Macros and highlight the macro's name and click the [Run] button.

Here is the code:

Sub FindPhoneNumbers()
Const resultsSheet = "Sheet1" ' change?
Const zipColumn = "A" ' change?
Const firstRowToCheck = 1 ' change?
Dim lastZipColumnRow As Long
Dim zipRange As Range
Dim anyZip As Object

Const tableSheet = "Sheet2" ' change?
Const tableStartCol = "A" ' change?
'assumes all columns from A through D have
'zip codes to check on each row
Const tablePhoneNoCol = "E" ' change?
Const tableFirstRow = 1 ' change?
Dim lastTableRow As Long
Dim tableColRange As Range
Dim anyTableZip As Object
Dim offsetToPhone As Integer
Dim phoneFound As String
Dim phoneMatchFlag As Boolean
Dim startCol As Integer
Dim endCol As Integer
Dim colLoop As Integer
Dim tmpAddress As String
Dim ckPhoneEntry As Integer

'find out some things about the Results sheet
lastZipColumnRow = Worksheets(resultsSheet). _
Range(zipColumn & Rows.Count).End(xlUp).Row
'set up to examine zip codes on Results sheet
Set zipRange = Worksheets(resultsSheet). _
Range(zipColumn & firstRowToCheck & ":" & zipColumn _
& lastZipColumnRow)
'find out things about the table and table sheet
lastTableRow = Worksheets(tableSheet). _
Range(tableStartCol & Rows.Count).End(xlUp).Row
startCol = Range(tableStartCol & "1").Column
endCol = Range(tablePhoneNoCol & "1").Column - 1

For Each anyZip In zipRange ' each entry on Results sheet
For colLoop = startCol To endCol ' each column in lookup table
offsetToPhone = Range(tablePhoneNoCol & "1").Column - colLoop
tmpAddress = Range(tableStartCol & tableFirstRow). _
Offset(0, colLoop - 1).Address & ":" & _
Range(tableStartCol & tableFirstRow). _
Offset(lastTableRow - tableFirstRow, colLoop - 1).Address
'set reference to this column in the lookup table
Set tableColRange = Worksheets(tableSheet).Range(tmpAddress)
'start looking for matches to zip codes
For Each anyTableZip In tableColRange
If anyTableZip.Value = anyZip.Value Then
'we have a zip code match
'get the associated phone #
phoneFound = anyTableZip.Offset(0, offsetToPhone)
'has this phone # already been reported?
ckPhoneEntry = 1 ' offset 1 col from zip code on Results Sheet
phoneMatchFlag = False
Do Until IsEmpty(anyZip.Offset(0, ckPhoneEntry))
If phoneFound = anyZip.Offset(0, ckPhoneEntry).Value Then
phoneMatchFlag = True
Exit Do
End If
ckPhoneEntry = ckPhoneEntry + 1
Loop ' reported phone check loop end
If phoneMatchFlag = False Then
'no match found, add new phone # to row
anyZip.Offset(0, ckPhoneEntry) = phoneFound
End If
End If
Next ' end anyTableZip loop
Next ' end colLoop loop
Next ' end anyZip loop
End Sub


"saman110 via OfficeKB.com" wrote:

Hello all,

In sheet1 Col.A I have many Zip codes and In sheet2 Col.A,B,C,D I have many
Zip codes also and in Col.E I have Phone numbers. How can I match Sheet1 Col.
A cell A:1 with sheet2 Col.A,B,C,D and If matches I would like to Copy
corresponding Col.E cell to sheet1 Col.B and look for the next one below and
then to the end of the column then the next column and paste it to sheet1
corresponding row. Since I am interested in getting sheet2 Col.E matches I
will not neet to have duplicates, for example in the sample below I'll get
cell E:1 copied to sheet1 because A:1 matches and next time If B:1 had 94597
I wouldn't need to have E:2 because I already have it from Row.A.
I hope I explained right. And if I get dups. in result there will be no
problem I will delete them manually.

Thank you in advance.


Ex.

In Sheet1
Col.A
94597
94593
:
:

In Sheet2

Col.A Col.B Col.C Col.D Col.E

94597 94600 94591 96523 925 921
94598 94597 94597 97863 925 933
94599 94594 94597 35624 926 922
94597 94593 94565 94597 925 932


The result would be:

In sheet1

Col.A Col.B Col.C Col.D Col.E Col.F Col.G Col.H
94597 925 921 925 932 925 933 925 933 925 922 926 932
94593 925 932

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...excel/200708/1


  #3   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 80
Default Compare 4 columns and copy

Could you show me if I wanted to copy Col.F as well as Col.E what would I
change? I put E:F but it gave me error. I may have names next to phone number
that I want to copy them over too.

Other than that your VBA worked very well thank you so much.

JLatham wrote:
I believe you'll find that this code will work to accomplish the task,
without duplicated phone numbers on any row also.
I recommend making a copy of your workbook to do the testing in - since if
you make a change to the code (or not) that ends up causing existing entries
to be overwritten, they'll be gone forever. So make a copy of the workbook
and then ...

To put the code to work, first put it into your workbook:
Press [Alt]+[F11] to open the Visual Basic (VB) Editor. In the VB Editor
use its menu toolbar to choose Insert | Module. The copy the code and paste
it into the code module presented to you. Make any changes you need to to
the Const values I've marked with ' change? to reflect the actual names and
setup of your two worksheets. Close the VB Editor. To try it out, use Tools
| Macro | Macros and highlight the macro's name and click the [Run] button.

Here is the code:

Sub FindPhoneNumbers()
Const resultsSheet = "Sheet1" ' change?
Const zipColumn = "A" ' change?
Const firstRowToCheck = 1 ' change?
Dim lastZipColumnRow As Long
Dim zipRange As Range
Dim anyZip As Object

Const tableSheet = "Sheet2" ' change?
Const tableStartCol = "A" ' change?
'assumes all columns from A through D have
'zip codes to check on each row
Const tablePhoneNoCol = "E" ' change?
Const tableFirstRow = 1 ' change?
Dim lastTableRow As Long
Dim tableColRange As Range
Dim anyTableZip As Object
Dim offsetToPhone As Integer
Dim phoneFound As String
Dim phoneMatchFlag As Boolean
Dim startCol As Integer
Dim endCol As Integer
Dim colLoop As Integer
Dim tmpAddress As String
Dim ckPhoneEntry As Integer

'find out some things about the Results sheet
lastZipColumnRow = Worksheets(resultsSheet). _
Range(zipColumn & Rows.Count).End(xlUp).Row
'set up to examine zip codes on Results sheet
Set zipRange = Worksheets(resultsSheet). _
Range(zipColumn & firstRowToCheck & ":" & zipColumn _
& lastZipColumnRow)
'find out things about the table and table sheet
lastTableRow = Worksheets(tableSheet). _
Range(tableStartCol & Rows.Count).End(xlUp).Row
startCol = Range(tableStartCol & "1").Column
endCol = Range(tablePhoneNoCol & "1").Column - 1

For Each anyZip In zipRange ' each entry on Results sheet
For colLoop = startCol To endCol ' each column in lookup table
offsetToPhone = Range(tablePhoneNoCol & "1").Column - colLoop
tmpAddress = Range(tableStartCol & tableFirstRow). _
Offset(0, colLoop - 1).Address & ":" & _
Range(tableStartCol & tableFirstRow). _
Offset(lastTableRow - tableFirstRow, colLoop - 1).Address
'set reference to this column in the lookup table
Set tableColRange = Worksheets(tableSheet).Range(tmpAddress)
'start looking for matches to zip codes
For Each anyTableZip In tableColRange
If anyTableZip.Value = anyZip.Value Then
'we have a zip code match
'get the associated phone #
phoneFound = anyTableZip.Offset(0, offsetToPhone)
'has this phone # already been reported?
ckPhoneEntry = 1 ' offset 1 col from zip code on Results Sheet
phoneMatchFlag = False
Do Until IsEmpty(anyZip.Offset(0, ckPhoneEntry))
If phoneFound = anyZip.Offset(0, ckPhoneEntry).Value Then
phoneMatchFlag = True
Exit Do
End If
ckPhoneEntry = ckPhoneEntry + 1
Loop ' reported phone check loop end
If phoneMatchFlag = False Then
'no match found, add new phone # to row
anyZip.Offset(0, ckPhoneEntry) = phoneFound
End If
End If
Next ' end anyTableZip loop
Next ' end colLoop loop
Next ' end anyZip loop
End Sub

Hello all,

[quoted text clipped - 37 lines]
94597 925 921 925 932 925 933 925 933 925 922 926 932
94593 925 932


--
Message posted via http://www.officekb.com

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
how to compare two columns on two sheets and copy associated data from one sheet to the other? [email protected] Excel Worksheet Functions 2 June 22nd 07 03:40 PM
compare and copy Arain Excel Discussion (Misc queries) 1 September 18th 06 01:04 PM
Compare and copy AJM1949 Excel Discussion (Misc queries) 2 April 6th 06 07:07 AM
Compare and copy Mary Excel Worksheet Functions 2 January 24th 06 05:22 AM


All times are GMT +1. The time now is 02:21 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"