Need to remove blank lines

Avogadro

Board Regular
Joined
Apr 29, 2010
Messages
59
I use this code to copy and paste addresses into a excel sheet and it works well. However if there are blank lines between the name, address and city/state lines it fails. How can I modify it to remove the blank lines?



Code:
Sub SameAsBillTo()
 Application.ScreenUpdating = False
 Application.CutCopyMode = False
Dim x As Variant
Dim fndList As Variant
Dim replaceList As Variant
Dim y As Long
Dim clipboard As MSForms.DataObject
Dim str1, str2, str3, str4, str5, str6, str7, str8, str9, arr() As String
Set clipboard = New MSForms.DataObject
clipboard.GetFromClipboard
str1 = clipboard.GetText
str1 = UCase(str1)
arr() = Split(str1, vbCrLf)
ActiveSheet.Unprotect
Cells(4, 36).Resize(UBound(arr) + 1).Value = Application.Transpose(arr)
For Each x In Range(Cells(4, 36), Cells(8, 36))
x.Value = Trim(x.Value)
x.Replace What:=",", Replacement:=" "
x.Replace What:=".", Replacement:=" "
x.Replace What:="  ", Replacement:=" "
  
Next x
str2 = LTrim(RTrim(Cells(4, 36)))  'Name
str3 = LTrim(RTrim(Cells(5, 36)))  'Street / 4 Line Company
str4 = LTrim(RTrim(Cells(6, 36)))  '4 Line Street /4 Line citystatezip
str5 = LTrim(RTrim(Cells(7, 36)))  '4 Line citystatezip /4 Line country
str6 = LTrim(RTrim(Cells(8, 36)))  'Country
str7 = LTrim(RTrim(Cells(8, 36)))  'Country
str8 = Replace(Right(str5, 10), "-", "") 'USA Zip
str9 = Replace(Right(str5, 5), "-", "")
If IsNumeric(str8) Or IsNumeric(str9) Then
str8 = "USA"
End If
'CANADA
If str5 = "CANADA" Or str7 = "CANADA" Then
On Error Resume Next
fndList = Array("Alberta", "British Columbia", "New Brunswick", "Manitoba", "Northwest Territories", "Nova Scotia", "Nunavut", "Ontario", _
"Prince Edward Island", "Quebec", "Saskatchewan", "Yukon", "Newfoundland", "Labrador")
replaceList = Array("AB", "BC", "NB", "MB", "NT", "NS", "NU", "ON", "PE", "QC", "SK", "YT", "NL", "L")
For y = LBound(fndList) To UBound(fndList)
For Each x In Range(Cells(6, 36), Cells(7, 36))
x.Replace What:=fndList(y), Replacement:=replaceList(y)
Next x
Next
End If
str4 = Cells(6, 36)
str5 = Cells(7, 36)
fndList = Array("Street", "Avenue", "Road", "Boulevard", "Lane", "Suite", "Apartment", "Room", "Building", "Center")
replaceList = Array("ST", "AVE", "RD", "BLVD", "LN", "STE", "APT", "RM", "BLDG", "CTR")
For y = LBound(fndList) To UBound(fndList)
    
For Each x In Range(Cells(5, 36), Cells(7, 36))
x.Replace What:=fndList(y), Replacement:=replaceList(y)
Next x
Next
str3 = Cells(5, 36)
str4 = Cells(6, 36)
str5 = Cells(7, 36)

On Error Resume Next
If str7 = "CANADA" And Mid(str5, Len(str5) - 3, 1) = " " Then
str5 = Mid(str5, 1, Len(str5) - 4) & Mid(str5, Len(str5) - 2)
Cells(7, 36).Value = str5
GoTo Line100
End If
If str5 = "CANADA" And Mid(str4, Len(str4) - 3, 1) = " " Then
str4 = Mid(str4, 1, Len(str4) - 4) & Mid(str4, Len(str4) - 2)
Cells(6, 36).Value = str4
GoTo Line200

End If

'USA / without company
If str5 = "" And str7 = "" Then
Cells(10, 6) = str2
Cells(10, 11) = str2
Cells(11, 6) = str3
Cells(11, 11) = str3
Cells(13, 6) = str4
Cells(13, 11) = str4
Cells(14, 6) = str6
Cells(14, 11) = str6
End If
'USA / with Company
Line50:
If str5 <> "" And str6 = "" And str8 = "USA" Then
Cells(10, 6) = str2
Cells(15, 11) = str2
Cells(10, 11) = str3
Cells(11, 6) = str4
Cells(11, 11) = str4
Cells(13, 6) = str5
Cells(13, 11) = str5
Cells(14, 6) = str6
Cells(14, 11) = str6
GoTo Line250
End If
'International / with Company
Line100:
If str5 <> "" And str6 <> "" Then
Cells(10, 6) = str2
Cells(15, 11) = str2
Cells(10, 11) = str3
Cells(11, 6) = str4
Cells(11, 11) = str4
Cells(13, 6) = str5
Cells(13, 11) = str5
Cells(14, 6) = str6
Cells(14, 11) = str6
GoTo Line250
End If
'International / no Company
If str5 <> "Canada" And str6 = "" And str7 = "" Then
Cells(10, 6) = str2
Cells(10, 11) = str2
Cells(11, 6) = str3
Cells(11, 11) = str3
Cells(13, 6) = str4
Cells(13, 11) = str4
Cells(14, 6) = str5
Cells(14, 11) = str5
GoTo Line250
End If
Line200:
'Canada / no Company
If str5 <> "" And str6 = "" And str7 = "" Then
Cells(10, 6) = str2
Cells(10, 11) = str2
Cells(11, 6) = str3
Cells(11, 11) = str3
Cells(13, 6) = str4
Cells(13, 11) = str4
Cells(14, 6) = str5
Cells(14, 11) = str5
End If

Line250:
Load Parser
With Parser
   .txtAddress.Value = Cells(13, 11).Value
   .txtName.Value = Cells(10, 11).Value
   .txtStreet.Value = Cells(11, 11).Value
End With
With Parser
On Error Resume Next
  .StartUpPosition = 0
  .Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
  .Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
  .Show
End With
Worksheets("Invoice").Range(Cells(4, 36), Cells(9, 36)).ClearContents
ActiveSheet.Protect
 
End Sub
 

Some videos you may like

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,446
Office Version
  1. 2013
Platform
  1. Windows
Do you mean blank rows on the worksheet, or blank lines within a cell?
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,446
Office Version
  1. 2013
Platform
  1. Windows
This would take care of the blank rows.

Code:
Sub t()
lr = ActiveSheet.Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
For r = lr To 2 Step -1
    If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next
End Sub
The exception would be if the rows have formulas which produce a value of empty string (""), then the code fails.
 
Last edited:

Avogadro

Board Regular
Joined
Apr 29, 2010
Messages
59
I copy the address into the clipboard and then run the macro. So immediately after "Set clipboard = New MSForms.DataObject
clipboard.GetFromClipboard
 

Avogadro

Board Regular
Joined
Apr 29, 2010
Messages
59

ADVERTISEMENT

Something like this but a bit more functional.

Set clipboard = New MSForms.DataObject
clipboard.GetFromClipboard
str1 = clipboard.GetText
str1 = UCase(str1)
str1= Loose the blank rows!(str1)
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,446
Office Version
  1. 2013
Platform
  1. Windows
I don't know how you would be able to do it while putting it on the clip board but you should be able to do something with it after it is put into the array.
I am guessing, but I would say the most likely items to be blank would be the second line for the address and the second line for the country. If That is the case then you could do something like this
Code:
str2 = LTrim(RTrim(Cells(4, 36)))  'Name
str3 = LTrim(RTrim(Cells(5, 36)))  'Street / 4 Line Company
If str4.Value <> "" then
    str4 = LTrim(RTrim(Cells(6, 36)))  '4 Line Street /4 Line citystatezip
End If
If str5.Value <> "" Then
    str5 = LTrim(RTrim(Cells(7, 36)))  '4 Line citystatezip /4 Line country
End If
str6 = LTrim(RTrim(Cells(8, 36)))  'Country
If str7.value <> "" Then
    str7 = LTrim(RTrim(Cells(8, 36)))  'Country
End If
str8 = Replace(Right(str5, 10), "-", "") 'USA Zip
str9 = Replace(Right(str5

or does the error occur before that point in the code?
 
Last edited:

Avogadro

Board Regular
Joined
Apr 29, 2010
Messages
59
The code evaluates the number of lines in the address and determines if it is a 3 line domestic or a four line domestic(with Company name) or a four or five line international address.
Initially the entire address is assigned as str1. Then it is transposed vertically with each line being assigned a str#. So if a three line address is copied with blank rows it will appear as a five line address. Of course that throws off the rest of the macro.
So I'm thinking I want to remove the blanks before the array is transposed. How can I remove the blanks in str1 between line 6 and 7 below.
1 Set clipboard = New MSForms.DataObject
2 clipboard.GetFromClipboard
3 str1 = clipboard.GetText
4 str1 = UCase(str1)
5 arr() = Split(str1, vbCrLf)
6 ActiveSheet.Unprotect
7 Cells(4, 36).Resize(UBound(arr) + 1).Value = Application.Transpose(arr)
8 For Each x In Range(Cells(4, 36), Cells(8, 36))
9 x.Value = Trim(x.Value)
10 x.Replace What:=",", Replacement:=" "
x.Replace What:=".", Replacement:=" "
x.Replace What:=" ", Replacement:=" "

Next x
str2 = LTrim(RTrim(Cells(4, 36))) 'Name
str3 = LTrim(RTrim(Cells(5, 36))) 'Street / 4 Line Company
str4 = LTrim(RTrim(Cells(6, 36))) '4 Line Street /4 Line citystatezip
str5 = LTrim(RTrim(Cells(7, 36))) '4 Line citystatezip /4 Line country
str6 = LTrim(RTrim(Cells(8, 36))) 'Country
str7 = LTrim(RTrim(Cells(8, 36))) 'Country
str8 = Replace(Right(str5, 10), "-", "") 'USA Zip
 

Watch MrExcel Video

Forum statistics

Threads
1,109,341
Messages
5,528,146
Members
409,802
Latest member
joeino

This Week's Hot Topics

  • Change military grades into rank
    Afternoon all Need help with formula that will change military rank (i.e. 1, 2, 3 into Amn, A1C, SrA). Running IF formula that does not work...
  • VBA COUNTIF SOLUTION
    Hi The following are the errors spread across the several columns from E to Q ie. 13 columns across several sheets with more than 500 rows per...
  • INSERT ROW WITH SPECIFIS TEXT IN A COLUMN
    Hi All! How can identify that that the row to be inserted has to be inserted before 1st row with specific text in column F. If I record the...
  • Auto-Create a monthly Sign in sheet for preschool students
    The image below is what each page looks like. Above is space for the "Child Name" "Month" "Class" School days are obviously Monday-Friday but...
  • VBA vlookup multiple results
    Hi folks, Hopefully someone out there can help. I have a list to vlookup which works (ish). the lookup only picks up the first instance of the...
  • Extract values for earliest/latest times
    I am trying to put together a formula to get the earliest start time, the latest end time from column A for each person in Column B-F without the...
Top