Copy Rows, Paste into New Sheet, Then Paste twice if Address2 is Different then replace Address 1 with Address2 on 2nd line

jeffcoleky

Active Member
Joined
May 24, 2011
Messages
274
I hope my title wasn't too long and was helpful! :) It explains my issue pretty nicely. Here is a list of addresses we have in excel.

Excel 2010
ABCDEFGHI
1OwnersStreet1City1State1Zip1Street2City2State2Zip2
2Antuane & Tiffany Samarka5369 Brentwood AveWoolstockIA50599536 Brentwood AveWoolstockIA50599
3Sally Kellam & Kirk Bolder278 Fleming AveWoolstockIA505992718 Fleming AveWoolstockIA50599
4James & Connie Macdonald1114 Lansford DrWoolstockIA5059911114 Lansford DrWoolstockIA50599
5Paula & Douglas Mills1019 Allen DrWoolstockKY50599146 Breckenridge Ln Apt B2WoolstockKY50599
6Theresa Jackson1012 Blue Creek DrWoolstockKY5059910112 Blue Creek DrWoolstockKY50599
7Jon Smith6214 Maravian DrLedyardIA50556123 Main StLouisvilleKY40258
8Sally Jones1822 Golden DrWoolstockIA50599552 Jones StLouisvilleKY40272
9Thomas Wong & Billie Chai3709 Astrocraft DrLedyardIA50556111 Maple StLouisvilleKY40229

<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>
Sheet1
This is what we do manually that we'd like to automate with a macro:

1) Select a range of Rows
2) Copy
3) Paste values into "Export" sheet in same workbook, starting in row 2.
4) Look for all rows that have a different Address 2 (Street, City, State, & Zip) than the Address 1 and Duplicate those rows
5) Replace Address 1 with Address 2 on the duplicate line.​

The result looks like this:

Excel 2010
ABCDEFGHI
1OwnersStreet1City1State1Zip1Street2City2State2Zip2
2Antuane & Tiffany Samarka5369 Brentwood AveWoolstockIA50599536 Brentwood AveWoolstockIA50599
3Sally Kellam & Kirk Bolder278 Fleming AveWoolstockIA505992718 Fleming AveWoolstockIA50599
4James & Connie Macdonald1114 Lansford DrWoolstockIA5059911114 Lansford DrWoolstockIA50599
5Paula & Douglas Mills1019 Allen DrWoolstockKY50599146 Breckenridge Ln Apt B2WoolstockKY50599
6Theresa Jackson1012 Blue Creek DrWoolstockKY5059910112 Blue Creek DrWoolstockKY50599
7Jon Smith6214 Maravian DrLedyardIA50556123 Main StLouisvilleKY40258
8Sally Jones1822 Golden DrWoolstockIA50599552 Jones StLouisvilleKY40272
9Thomas Wong & Billie Chai3709 Astrocraft DrLedyardIA50556111 Maple StLouisvilleKY40229
10Jon Smith123 Main StLouisvilleKY40258123 Main StLouisvilleKY40258
11Sally Jones552 Jones StLouisvilleKY40272552 Jones StLouisvilleKY40272
12Thomas Wong & Billie Chai111 Maple StLouisvilleKY40229111 Maple StLouisvilleKY40229

<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>
Export



Then we use mail merge in word to create mailing labels from this list.

Is there a smarter way to do this?
 
jeffcoleky,

PS. sorry for the confusion, I just realized the addresses in the first 3 rows were similar but not identical. Treat them as identical.

Please display screenshots with highlighting, and with the correct input, and, output.
 
Upvote 0

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
RAW: (Highlighted = Selected when macro is run)

Excel 2010
ABCDEFGHI
1OwnersStreet1City1State1Zip1Street2City2State2Zip2
2Antuane & Tiffany Samarka539 Brentwood AveWoolstockIA50599539 Brentwood AveWoolstockIA50599
3Sally Kellam & Kirk Bolder278 Fleming AveWoolstockIA50599278 Fleming AveWoolstockIA50599
4James & Connie Macdonald1114 Lansford DrWoolstockIA5059911114 Lansford DrWoolstockIA50599
5Paula & Douglas Mills1019 Allen DrWoolstockKY50599146 Breckenridge Ln Apt B2WoolstockKY50599
6Theresa Jackson1012 Blue Creek DrWoolstockKY5059910112 Blue Creek DrWoolstockKY50599
7Jon Smith6214 Maravian DrLedyardIA50556123 Main StLouisvilleKY40258
8Sally Jones1822 Golden DrWoolstockIA50599552 Jones StLouisvilleKY40272
9Thomas Wong & Billie Chai3709 Astrocraft DrLedyardIA50556111 Maple StLouisvilleKY40229

<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>
Sheet1



Output of macro:

Excel 2010
ABCDEFGHI
1OwnersStreet1City1State1Zip1Street2City2State2Zip2
2Antuane & Tiffany Samarka539 Brentwood AveWoolstockIA50599539 Brentwood AveWoolstockIA50599
3Sally Kellam & Kirk Bolder278 Fleming AveWoolstockIA50599278 Fleming AveWoolstockIA50599
4Sally Jones1822 Golden DrWoolstockIA50599552 Jones StLouisvilleKY40272
5Thomas Wong & Billie Chai3709 Astrocraft DrLedyardIA50556111 Maple StLouisvilleKY40229
6Sally Jones552 Jones StLouisvilleKY40272552 Jones StLouisvilleKY40272
7Thomas Wong & Billie Chai111 Maple StLouisvilleKY40229111 Maple StLouisvilleKY40229

<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>
Export
 
Upvote 0
jeffcoleky,

Sample raw data in Sheet1:


Excel 2007
ABCDEFGHI
1OwnersStreet1City1State1Zip1Street2City2State2Zip2
2Antuane & Tiffany Samarka539 Brentwood AveWoolstockIA50599539 Brentwood AveWoolstockIA50599
3Sally Kellam & Kirk Bolder278 Fleming AveWoolstockIA50599278 Fleming AveWoolstockIA50599
4James & Connie Macdonald1114 Lansford DrWoolstockIA5059911114 Lansford DrWoolstockIA50599
5Paula & Douglas Mills1019 Allen DrWoolstockKY50599146 Breckenridge Ln Apt B2WoolstockKY50599
6Theresa Jackson1012 Blue Creek DrWoolstockKY5059910112 Blue Creek DrWoolstockKY50599
7Jon Smith6214 Maravian DrLedyardIA50556123 Main StLouisvilleKY40258
8Sally Jones1822 Golden DrWoolstockIA50599552 Jones StLouisvilleKY40272
9Thomas Wong & Billie Chai3709 Astrocraft DrLedyardIA50556111 Maple StLouisvilleKY40229
10
Sheet1


After the macro in worksheet Export:


Excel 2007
ABCDEFGHI
1OwnersStreet1City1State1Zip1Street2City2State2Zip2
2Antuane & Tiffany Samarka539 Brentwood AveWoolstockIA50599539 Brentwood AveWoolstockIA50599
3Sally Kellam & Kirk Bolder278 Fleming AveWoolstockIA50599278 Fleming AveWoolstockIA50599
4Sally Jones1822 Golden DrWoolstockIA50599552 Jones StLouisvilleKY40272
5Sally Jones552 Jones StLouisvilleKY40272552 Jones StLouisvilleKY40272
6Thomas Wong & Billie Chai3709 Astrocraft DrLedyardIA50599111 Maple StLouisvilleKY40229
7Thomas Wong & Billie Chai111 Maple StLouisvilleKY40229111 Maple StLouisvilleKY40229
8
Export


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Code:
Option Explicit
Sub CheckDupeAddressV4()
' hiker95, 02/23/2013
' http://www.mrexcel.com/forum/excel-questions/687418-copy-rows-paste-into-new-sheet-then-paste-twice-if-address2-different-then-replace-address-1-address2-2nd-line.html
Dim b As Variant, lr As Long, lc As Long, r As Long, ii As Long, s1 As String, s2 As String
With Worksheets("Sheet1")
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  lc = .Cells(1, Columns.Count).End(xlToLeft).Column
  ReDim b(1 To (lr * 2), 1 To lc)
  ii = 1
  b(ii, 1) = .Cells(1, 1): b(ii, 2) = .Cells(1, 2): b(ii, 3) = .Cells(1, 3)
  b(ii, 4) = .Cells(1, 4): b(ii, 5) = .Cells(1, 5): b(ii, 6) = .Cells(1, 6)
  b(ii, 7) = .Cells(1, 7): b(ii, 8) = .Cells(1, 8): b(ii, 9) = .Cells(1, 9)
  For r = 2 To lr
    If .Cells(r, 1).Interior.Color = 65535 Then
      s1 = Application.Replace(.Cells(r, 2), 1, Application.Search(" ", .Cells(r, 2), 1), "")
      s2 = Application.Replace(.Cells(r, 6), 1, Application.Search(" ", .Cells(r, 6), 1), "")
      If s1 = s2 Then
        ii = ii + 1
        b(ii, 1) = .Cells(r, 1): b(ii, 2) = .Cells(r, 2): b(ii, 3) = .Cells(r, 3)
        b(ii, 4) = .Cells(r, 4): b(ii, 5) = .Cells(6, 5): b(ii, 6) = .Cells(r, 6)
        b(ii, 7) = .Cells(r, 7): b(ii, 8) = .Cells(r, 8): b(ii, 9) = .Cells(r, 9)
      ElseIf s1 <> s2 Then
        ii = ii + 1
        b(ii, 1) = .Cells(r, 1): b(ii, 2) = .Cells(r, 2): b(ii, 3) = .Cells(r, 3)
        b(ii, 4) = .Cells(r, 4): b(ii, 5) = .Cells(6, 5): b(ii, 6) = .Cells(r, 6)
        b(ii, 7) = .Cells(r, 7): b(ii, 8) = .Cells(r, 8): b(ii, 9) = .Cells(r, 9)
        ii = ii + 1
        b(ii, 1) = .Cells(r, 1): b(ii, 2) = .Cells(r, 6): b(ii, 3) = .Cells(r, 7)
        b(ii, 4) = .Cells(r, 8): b(ii, 5) = .Cells(r, 9): b(ii, 6) = .Cells(r, 6)
        b(ii, 7) = .Cells(r, 7): b(ii, 8) = .Cells(r, 8): b(ii, 9) = .Cells(r, 9)
      End If
    End If
  Next r
End With
If Not Evaluate("ISREF(Export!A1)") Then Worksheets.Add(After:=Worksheets("Sheet1")).Name = "Export"
With Worksheets("Export")
  .UsedRange.Clear
  .Cells(1, 1).Resize(UBound(b, 1), UBound(b, 2)) = b
  .Cells.EntireColumn.AutoFit
  .Activate
End With
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the CheckDupeAddressV4 macro.
 
Upvote 0
Same result on my end as the last one... try highlighting ONE row and running macro, it still does all of them. In fact, now it doesn't copy all the zip codes over either.

Sorry to be so difficult. I can work around it the way it is if it's not going to be an easy change.
 
Upvote 0
jeffcoleky,

How are you highlighting the data?

It could be that the highlighting you are using is not the same .Interior.Color = 65535 that I am finding on your posted screenshots.

I will need to see your sample workbook.

You can upload your workbook to Box Net,
sensitive data scrubbed/removed/changed
mark the workbook for sharing
and provide us with a link to your workbook.


After 4 versions of the macro, if you cannot provide a sample workbook, then:

Click on the Reply to Thread button, and just put the word BUMP in the post. Then, click on the Post Quick Reply button, and someone else will assist you.
 
Upvote 0
jeffcoleky,

In your latest workbook, worksheet Message for Hiker95, contained:


Excel 2007
A
1Dear Hiker95, You have the macro exactly right with only one change. I want to be able to run the macro on a SELECTION rather than on the entire sheet1.
2**Normally I don't use colors but you have asked me to highlight the rows to show which rows I'm exporting so I have done so.
3For example:
4Assume I ONLY want to export rows 2, 3, 8, 9
5I ctrl-select each row and run the macro.
6The end result is displayed in the "Export" Tab
7
8
9
10THANK YOU FOR YOUR HELP!
Message for Hiker95


There has been unclear communication concerning the results you are looking for. And, there has been 4 versions of the macro because of this.

I just tried to use your row selection of non-contiguous rows, and, I can not get the data into an array.

Click on the Reply to Thread button, and just put the word BUMP in the post. Then, click on the Post Quick Reply button, and someone else will assist you.
 
Last edited:
Upvote 0
jeffcoleky,

In your latest workbook, worksheet Message for Hiker95, contained:

I just tried to use your row selection of non-contiguous rows, and, I can not get the data into an array.

Click on the Reply to Thread button, and just put the word BUMP in the post. Then, click on the Post Quick Reply button, and someone else will assist you.

I can appreciate your desire to move on. That's not a problem.

However, the issue could be that you didn't download the file. There are two more tabs in that file and Box will only display the first one in "Preview" mode. I'm confused as to why you cannot access the other tab in the attached file to use it in an array--it's a simple new workbook. I'm also baffled as to how to explain the final change any differently.

No matter though! We'll just call this project "Done". I can make do with what you have given me. It is 90% of what i needed and it saves me a LOT of time just the way it is. I just need to add an extra step of copying the rows I want exported to a new sheet before running the macro. Then it should work fine--even with the first version.

Thank you again for your time! I apologize for being unclear.
 
Upvote 0

Forum statistics

Threads
1,221,418
Messages
6,159,791
Members
451,589
Latest member
Harold14

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top