Need to remove blank lines

[Avogadro]

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?

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

 

[JLGWhiz]

Do you mean blank rows on the worksheet, or blank lines within a cell?

 

[JLGWhiz]

This would take care of the blank rows.

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.

 

[Avogadro]

I copy the address into the clipboard and then run the macro. So immediately after "Set clipboard = New MSForms.DataObject
clipboard.GetFromClipboard

 

[Avogadro]

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]

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

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?

 

[Avogadro]

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