Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
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
Posted to microsoft.public.excel.misc
|
|||
|
|||
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
Posted to microsoft.public.excel.misc
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
how to compare two columns on two sheets and copy associated data from one sheet to the other? | Excel Worksheet Functions | |||
compare and copy | Excel Discussion (Misc queries) | |||
Compare and copy | Excel Discussion (Misc queries) | |||
Compare and copy | Excel Worksheet Functions |