Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Creating an Excel sheet with Addresses using a Macro
I have a list of addresses that are sepperated by a blank row. The address
number around 4000. All information is stored in Column A down each of the rows. Instead, I would like it go across so that it is easy to merge into a document for mailing. The addresses are similar to those below: Company Name 1 123 Company Road Any Town, AL 12345 - 6789 (555) 555-5555 Company Name 2 234 Company Road Another Town, AK 23456-7890 (555) 555-0000 Company Name 3 Different Town, NY 34567-6543 (555) 555-1111 As you can see, some have three and some have four rows for the address (not all of them have street addresses in them). What I want is something like this: Company Name 1 1234 Company Road Any Town, AL 12345 - 6789 (555) 555-5555 Company Name 2 234 Company Road Another Town, AK 23456-7890 (555) 555-0000 Company Name 3 Different Town, NY 34567-6543 (555) 555-1111 (Please note, I want the phone number in one column as it normally would appear.) Just so you know, all of the Company Names are bold and of a blue color (instead of black); not all of the zip codes are nine-digit, some are five digit; all of the street addresses start with a number or "PO Box"; the phone numbers are all formatted as (###) ###-#### and are bold; and there is a blank (empty) cell at the end of each address. I have very little Macro Programming, but I was thinking of something along the rough idea of: Go to cell A2 and do the following for each If the color of the selected cell is blue, then leave it where it is. Increase the row of column A by 1 (in this case, A3) If the selected cell begins with a number or "PO Box", then cut and paste it to Column B one row above it's current spot, else cut and paste it to Column C one row above it's current spot. Delete the empty cell left from the cut. If the selected cell begins with a "(", then cut and paste it to Column D one row above it's current spot. Delete the empty cell left from the cut. If the selected cell is empty, then delete the empty cell and shift the rows up. Obviously this isn't programming language, but I thought I would get my ideas out on paper first before attempting to get some coding help. Thanks in advance for anyone's thoughts, comments, suggestions, and help on this! Aaron |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Creating an Excel sheet with Addresses using a Macro
Try running this against a copy of your worksheet--it'll destroy the original.
Option Explicit Sub testme() Dim wks As Worksheet Dim iRow As Long Dim myRng As Range Dim myStr As String Dim myDigits As String Dim myArea As Range Dim TopRow As Long Set wks = Worksheets("Sheet1") With wks Set myRng = Nothing On Error Resume Next Set myRng = .Range("a:a").Cells.SpecialCells(xlCellTypeFormula s) On Error GoTo 0 If myRng Is Nothing Then 'keep going Else MsgBox "Please convert formulas to values!" Exit Sub End If Set myRng = Nothing On Error Resume Next Set myRng = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp)) _ .Cells.SpecialCells(xlCellTypeConstants) On Error GoTo 0 If myRng Is Nothing Then MsgBox "No constants found!" Exit Sub End If End With For Each myArea In myRng.Areas With myArea For iRow = .Row To .Cells(.Cells.Count).Row myStr = Trim(.Parent.Cells(iRow, "A").Value) If iRow = .Row Then TopRow = iRow .Parent.Cells(TopRow, "c").Value = myStr Else If LCase(Left(myStr, 2)) = "po" _ Or LCase(Left(myStr, 5)) = "pobox" _ Or LCase(Left(myStr, 6)) = "po box" _ Or IsNumeric(Left(myStr, 1)) Then .Parent.Cells(TopRow, "d").Value = myStr Else With Application myDigits = myStr myDigits = .Substitute(myDigits, "(", "") myDigits = .Substitute(myDigits, ")", "") myDigits = .Substitute(myDigits, " ", "") myDigits = .Substitute(myDigits, "-", "") myDigits = .Substitute(myDigits, ".", "") End With If IsNumeric(myDigits) Then .Parent.Cells(TopRow, "F").Value = myStr Else If IsNumeric(Right(myStr, 4)) _ And IsNumeric(Left(myStr, 1)) = False Then .Parent.Cells(TopRow, "E").Value = myStr Else .Parent.Cells(iRow, "B").Value = "***ERROR***" End If End If End If End If Next iRow End With Next myArea With wks If Application.CountIf(.Range("B:B"), "*error*") 0 Then MsgBox "Errors found!" Exit Sub Else On Error Resume Next .Range("C:C").Cells.SpecialCells(xlCellTypeBlanks) .EntireRow.Delete On Error GoTo 0 .Range("a:b").Delete End If .UsedRange.EntireColumn.AutoFit End With End Sub I didn't use the boldness of the cell to determine the company name--I just used the first cell in that grouping. KnightRiderAW wrote: I have a list of addresses that are sepperated by a blank row. The address number around 4000. All information is stored in Column A down each of the rows. Instead, I would like it go across so that it is easy to merge into a document for mailing. The addresses are similar to those below: Company Name 1 123 Company Road Any Town, AL 12345 - 6789 (555) 555-5555 Company Name 2 234 Company Road Another Town, AK 23456-7890 (555) 555-0000 Company Name 3 Different Town, NY 34567-6543 (555) 555-1111 As you can see, some have three and some have four rows for the address (not all of them have street addresses in them). What I want is something like this: Company Name 1 1234 Company Road Any Town, AL 12345 - 6789 (555) 555-5555 Company Name 2 234 Company Road Another Town, AK 23456-7890 (555) 555-0000 Company Name 3 Different Town, NY 34567-6543 (555) 555-1111 (Please note, I want the phone number in one column as it normally would appear.) Just so you know, all of the Company Names are bold and of a blue color (instead of black); not all of the zip codes are nine-digit, some are five digit; all of the street addresses start with a number or "PO Box"; the phone numbers are all formatted as (###) ###-#### and are bold; and there is a blank (empty) cell at the end of each address. I have very little Macro Programming, but I was thinking of something along the rough idea of: Go to cell A2 and do the following for each If the color of the selected cell is blue, then leave it where it is. Increase the row of column A by 1 (in this case, A3) If the selected cell begins with a number or "PO Box", then cut and paste it to Column B one row above it's current spot, else cut and paste it to Column C one row above it's current spot. Delete the empty cell left from the cut. If the selected cell begins with a "(", then cut and paste it to Column D one row above it's current spot. Delete the empty cell left from the cut. If the selected cell is empty, then delete the empty cell and shift the rows up. Obviously this isn't programming language, but I thought I would get my ideas out on paper first before attempting to get some coding help. Thanks in advance for anyone's thoughts, comments, suggestions, and help on this! Aaron -- Dave Peterson |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Creating an Excel sheet with Addresses using a Macro
Thanks, Dave! This got it very close. I was able to finish up using what
you gave me. Again, thanks! Aaron "Dave Peterson" wrote: Try running this against a copy of your worksheet--it'll destroy the original. Option Explicit Sub testme() Dim wks As Worksheet Dim iRow As Long Dim myRng As Range Dim myStr As String Dim myDigits As String Dim myArea As Range Dim TopRow As Long Set wks = Worksheets("Sheet1") With wks Set myRng = Nothing On Error Resume Next Set myRng = .Range("a:a").Cells.SpecialCells(xlCellTypeFormula s) On Error GoTo 0 If myRng Is Nothing Then 'keep going Else MsgBox "Please convert formulas to values!" Exit Sub End If Set myRng = Nothing On Error Resume Next Set myRng = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp)) _ .Cells.SpecialCells(xlCellTypeConstants) On Error GoTo 0 If myRng Is Nothing Then MsgBox "No constants found!" Exit Sub End If End With For Each myArea In myRng.Areas With myArea For iRow = .Row To .Cells(.Cells.Count).Row myStr = Trim(.Parent.Cells(iRow, "A").Value) If iRow = .Row Then TopRow = iRow .Parent.Cells(TopRow, "c").Value = myStr Else If LCase(Left(myStr, 2)) = "po" _ Or LCase(Left(myStr, 5)) = "pobox" _ Or LCase(Left(myStr, 6)) = "po box" _ Or IsNumeric(Left(myStr, 1)) Then .Parent.Cells(TopRow, "d").Value = myStr Else With Application myDigits = myStr myDigits = .Substitute(myDigits, "(", "") myDigits = .Substitute(myDigits, ")", "") myDigits = .Substitute(myDigits, " ", "") myDigits = .Substitute(myDigits, "-", "") myDigits = .Substitute(myDigits, ".", "") End With If IsNumeric(myDigits) Then .Parent.Cells(TopRow, "F").Value = myStr Else If IsNumeric(Right(myStr, 4)) _ And IsNumeric(Left(myStr, 1)) = False Then .Parent.Cells(TopRow, "E").Value = myStr Else .Parent.Cells(iRow, "B").Value = "***ERROR***" End If End If End If End If Next iRow End With Next myArea With wks If Application.CountIf(.Range("B:B"), "*error*") 0 Then MsgBox "Errors found!" Exit Sub Else On Error Resume Next .Range("C:C").Cells.SpecialCells(xlCellTypeBlanks) .EntireRow.Delete On Error GoTo 0 .Range("a:b").Delete End If .UsedRange.EntireColumn.AutoFit End With End Sub I didn't use the boldness of the cell to determine the company name--I just used the first cell in that grouping. KnightRiderAW wrote: I have a list of addresses that are sepperated by a blank row. The address number around 4000. All information is stored in Column A down each of the rows. Instead, I would like it go across so that it is easy to merge into a document for mailing. The addresses are similar to those below: Company Name 1 123 Company Road Any Town, AL 12345 - 6789 (555) 555-5555 Company Name 2 234 Company Road Another Town, AK 23456-7890 (555) 555-0000 Company Name 3 Different Town, NY 34567-6543 (555) 555-1111 As you can see, some have three and some have four rows for the address (not all of them have street addresses in them). What I want is something like this: Company Name 1 1234 Company Road Any Town, AL 12345 - 6789 (555) 555-5555 Company Name 2 234 Company Road Another Town, AK 23456-7890 (555) 555-0000 Company Name 3 Different Town, NY 34567-6543 (555) 555-1111 (Please note, I want the phone number in one column as it normally would appear.) Just so you know, all of the Company Names are bold and of a blue color (instead of black); not all of the zip codes are nine-digit, some are five digit; all of the street addresses start with a number or "PO Box"; the phone numbers are all formatted as (###) ###-#### and are bold; and there is a blank (empty) cell at the end of each address. I have very little Macro Programming, but I was thinking of something along the rough idea of: Go to cell A2 and do the following for each If the color of the selected cell is blue, then leave it where it is. Increase the row of column A by 1 (in this case, A3) If the selected cell begins with a number or "PO Box", then cut and paste it to Column B one row above it's current spot, else cut and paste it to Column C one row above it's current spot. Delete the empty cell left from the cut. If the selected cell begins with a "(", then cut and paste it to Column D one row above it's current spot. Delete the empty cell left from the cut. If the selected cell is empty, then delete the empty cell and shift the rows up. Obviously this isn't programming language, but I thought I would get my ideas out on paper first before attempting to get some coding help. Thanks in advance for anyone's thoughts, comments, suggestions, and help on this! Aaron -- Dave Peterson |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Creating emailing list from column of addresses | Excel Discussion (Misc queries) | |||
email addresses tied to a spread sheet | Excel Discussion (Misc queries) | |||
How can I stop Excel from creating an e-mail link for addresses? | Excel Discussion (Misc queries) | |||
multiple addresses on one label sheet? | Charts and Charting in Excel | |||
Run Macro & Rename Sheet upon creating copy from blank. | Excel Programming |