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
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
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,979
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,979
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
 

Forum statistics

Threads
1,147,987
Messages
5,744,192
Members
423,852
Latest member
imohammed999

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
Top