#1
|
|||
|
|||
trying to compress 3 lines into one
i copied the data off of a website and the formatted it so that each different type of data ended up if a different column. (name, address, ect.) now i want to take that data and compress it all down to one line but there are 2 problems 1st all of the empty spots actually have a formula in them (ex: =a1), also one spot has #VALUE! and i need to get rid off all of them and the second is that one of the columns (name) might have more than one row filled up and i need both names (or to at least know that there are more names)
img attached |
#2
|
||||
|
||||
This would be far easier for someone to work on if you attached a workbook with some sample data & formulae, rather than leaving them to guess what they have to deal with. You do this via the paperclip symbol on the 'Go Advanced' tab at the bottom of this screen.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
here is the document
the document is attached
|
#4
|
||||
|
||||
Try the following macro, after which you probably won't need any of your formulae.
Code:
Sub CleanUp() Application.ScreenUpdating = False Dim i As Long, j As Long, k As Long With ActiveSheet With .UsedRange .Cells.Replace What:=Chr(160), Replacement:="", LookAt:=xlPart, SearchOrder:= _ xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False .UnMerge .VerticalAlignment = xlCenter .WrapText = False .HorizontalAlignment = xlLeft .Font.ColorIndex = xlAutomatic .Font.Underline = False End With While .Shapes.Count > 0 .Shapes(1).Delete Wend .Columns(9).Delete .Columns(8).Delete .Columns(6).Delete .Columns(5).Delete .Columns(4).Delete .Columns(2).Delete For i = 1 To .UsedRange.Rows.Count - 1 If .Cells(i, 6).Value = "MORTGAGE" Then .Cells(i, 5).Value = "MORTGAGE" .Cells(i, 6).Value = -(.Cells(i + 1, 6).Value) End If If Trim(.Cells(i, 2).Value) Like "####-#####" Then .Cells(i, 2).Value = Trim(.Cells(i, 2).Value) For j = i To .UsedRange.Rows.Count If Trim(.Cells(j, 1).Value) <> "" Then Exit For Next .Cells(i, 9).Value = .Cells(j, 1).Value For k = i + 1 To j If .Cells(k, 3).Value <> "" Then .Cells(i, 3).Value = .Cells(i, 3).Value & " / " & .Cells(k, 3).Value End If Next End If Next For i = .UsedRange.Rows.Count To 2 Step -1 If .Cells(i, 2).Value = "" Then .Rows(i).EntireRow.Delete Next .Columns(1).Delete .UsedRange.Rows.AutoFit .UsedRange.Columns.AutoFit End With Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#5
|
|||
|
|||
thanks
thank you that worked great.
i was also wondering if there is a way to take the street address and the county and put it into google or something to find the full address with zipcode |
#6
|
||||
|
||||
Possibly, but that's not something I have experience with. Besides which, your data includes no country or state/territory info and it seems from your attached workbook you regarded the locality information as also being wrong (or at least unreliable).
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#7
|
|||
|
|||
there all have the same state and county ... ny and tompkins county
|
#8
|
||||
|
||||
If have found some code for retrieving zip codes from the USPS website but, using that website, you can't look up zip codes by county - a town/city name is required. See: https://tools.usps.com/go/ZipLookupA...1&refresh=true
Only a small number of zip codes can be retrieved for your data. Bearing that in mind, you might try: Code:
Option Explicit Dim ieObj As Object Sub CleanUp() Application.ScreenUpdating = False Dim i As Long, j As Long, k As Long With ActiveSheet With .UsedRange .Cells.Replace What:=Chr(160), Replacement:="", LookAt:=xlPart, SearchOrder:= _ xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False .UnMerge .VerticalAlignment = xlCenter .WrapText = False .HorizontalAlignment = xlLeft .Font.ColorIndex = xlAutomatic .Font.Underline = False End With While .Shapes.Count > 0 .Shapes(1).Delete Wend .Columns(11).Delete .Columns(9).Delete .Columns(8).Delete .Columns(6).Delete .Columns(5).Delete .Columns(4).Delete .Columns(2).Delete For i = 1 To .UsedRange.Rows.Count - 1 If .Cells(i, 5).Value = "MORTGAGE" Then .Cells(i, 5).Value = -(.Cells(i + 1, 5).Value) End If If Trim(.Cells(i, 2).Value) Like "####-#####" Then .Cells(i, 2).Value = Trim(.Cells(i, 2).Value) For j = i To .UsedRange.Rows.Count If Trim(.Cells(j, 1).Value) <> "" Then Exit For Next .Cells(i, 8).Value = .Cells(j, 1).Value .Cells(i, 9).Value = Replace(Replace(.Cells(i, 7).Value, "City of ", ""), "Town of ", "") For k = i + 1 To j If .Cells(k, 3).Value <> "" Then .Cells(i, 3).Value = .Cells(i, 3).Value & " / " & .Cells(k, 3).Value End If Next End If Next For i = .UsedRange.Rows.Count To 2 Step -1 If .Cells(i, 2).Value = "" Then .Rows(i).EntireRow.Delete Next .Columns(7).Delete .Columns(1).Delete Call ZipUpdate .UsedRange.Rows.AutoFit .UsedRange.Columns.AutoFit End With Application.ScreenUpdating = True End Sub Sub ZipUpdate() Application.ScreenUpdating = False Dim i As Long Set ieObj = CreateObject("InternetExplorer.Application") With ActiveSheet For i = 2 To .UsedRange.Rows.Count .Cells(i, 8).Value = ZipCode(.Cells(i, 6).Value, .Cells(i, 7).Value, "NY") Next End With ieObj.Quit: Set ieObj = Nothing Application.ScreenUpdating = True End Sub Function ZipCode(Addr As String, City As String, State As String) As String Dim URL As String, AD As String, Ct As String, St As String, Data As String Dim Zip As String, i As Long, ieDoc As Object URL = "https://tools.usps.com/go/ZipLookupResultsAction!input.action?resultMode=0&companyName=&" & _ "address1=" & Addr & "&address2=&city=" & City & "&state=" & State & "&urbanCode=&postalCode=&zip=" With ieObj .navigate URL Do Until (.readyState = 4 And Not .Busy) DoEvents Loop Set ieDoc = .document Data = ieDoc.body.innerText Data = Right(Data, Len(Data) - 2400) If InStr(1, Data, "Here's the full address") = 0 Then ZipCode = "" Else Data = Mid(Data, InStr(1, Data, "Here's the full address") + 94, 100) ZipCode = Mid(Data, InStr(1, Data, "-") - 5, 10) End If End With Set ieDoc = Nothing End Function Call ZipUpdate and run the CleanUp macro without it. You could then run the ZipUpdate macro after you've fixed up the locality details.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Word 2013 - Compress pictures | charleswpj | Drawing and Graphics | 1 | 11-08-2015 12:36 AM |
Deleting grid lines but keeping the axis lines | CoffeeNut | Excel | 0 | 04-01-2013 01:50 PM |
How can I compress slide shows under Apple? | Cliff | PowerPoint | 0 | 01-10-2012 12:04 PM |
Compress Emails as Attachment | SJT | Outlook | 2 | 11-30-2011 01:36 PM |
Getting blank lines instead of supressed lines. | Welshie82 | Mail Merge | 2 | 11-14-2011 01:41 AM |