extracting information from a text using vba

[absan]

i have text file i need to take the address, account number (start with 200-xxxx-xxxx) and name from it and insert it into excel file.
that why im having problem with, looks like this i need to extract the bold information

""1615 MISSISSAUGA ROAD, ONW" 500-4 LT A/A 0 1 1 15 0 N Y 00000000 200-0000-0001 customer one
Attn Codes 0
HDW 409 DSR2 2.14459E+15 2-way SRVC: 154(154)
"L-191 COPELAND RIVER LAKE RD, O" NW 500-4 LT A/A 0 1 1 15 0 N Y 333-9494 200-0000-0002customer two
Attn Codes 37 0
HDW 435 NAV3 6.24472E+14 2-way SRVC: 154(154)
"86 WHITE LAKE DRIVE AD, ONW" 500-2 LT C/C 0 1 0 15 0 N N 00000000 200-0000-0003 customer three
Attn Codes 30.85
"2244 HWY, ONW" 500-2 LT C/C 0 1 0 1 0 N N 00000000 200-0000-0004 customer four "

please advice thanks

 

[EdNerd]

Rick:

I didn't think of just matching a simple all-numbers pattern. I almost always think of RegEx when I see a pattern (just used it for an Access form text box validation). Glad there are people smarter than me coming here! :8>)

absan:

strAdd = Replace(strAdd, Chr(34), "") means:
-- take the string variable called strAdd, find every set of double quotes (that's what Chr(34) means - search for info on character set) and replace it with nothing (for that, we use two double quotes with nothing in between, and write the result back into strAdd.


The code for this was:

    'Extract address; find " 500-" after address
    posChar = InStr(1, strText, " 500-")
    strAdd = Left(strText, posChar)
    'Clean out quotes
    strAdd = Replace(strAdd, Chr(34), "")
    'Clean of leading, ending spaces
    strAdd = Trim(strAdd)

The line you gave us for a valid customer was:
""1615 MISSISSAUGA ROAD, ONW" 500-4 LT A/A 0 1 1 15 0 N Y 00000000 200-0000-0001 customer one

My code is looking for "space500dash" - " 500-". If your customer lines have something other than that after the address, then the code would have to be adjusted to find it.

Ed

 

[absan]

No, I meant what I posted... 4 quote marks because you showed the address encased in quote marks (in Message #1)... your data in the text file does look like what you posted in Message #1 (at least one quote mark before the address and one mark after it), correct? If so, then what you posted above would omit the address from the output.

im not sure why but its working perfect without the 2nd qouts

 

[Rick Rothstein]

im not sure why but its working perfect without the 2nd qouts

Your data must differ from what you posted in some way.

 

[absan]

Your data must differ from what you posted in some way.

Rick any idea how can i split the address the address to (number streetname city province) what im doing now is after i run the macro i use a function

Function SplitString(pValue As String, pChar As String, pIndex As Integer) As Variant'Updateby20140612
SplitString = Split(pValue, pChar)(pIndex - 1)
End Function

then i call it with =SplitString(C1," ",2) from the cell but i would appreciate if you can help converting this into sub
unless there is better way to do this with the main code you provided?

thanks

 

[absan]

For those who might be interested, here is a way to do what the OP wants without using Regular Expressions (not tested, but I am thinking this might be faster)... I commented nearly every statement to make the logic easier to understand.

Sub GetCustInfo()
  Dim X As Long, Z As Long, Index As Long, FileNum As Long, Info As Variant
  Dim TotalFile As String, PathAndFileName As String, Lines() As String
  [COLOR=#008000]' Get the path and filename from the user[/COLOR]
  PathAndFileName = Application.GetOpenFilename()
  [COLOR=#008000]' Get an unused file channel number[/COLOR]
  FileNum = FreeFile
  [COLOR=#008000]' The next four statements read the entire file into the TotalFile string variable[/COLOR]
  Open PathAndFileName For Binary As #FileNum
    TotalFile = Space(LOF(FileNum))
    Get #FileNum, , TotalFile
  Close #FileNum
  [COLOR=#008000]' Split the entire file into its individual lines[/COLOR]
  Lines = Split(TotalFile, vbNewLine)
  [COLOR=#008000]' Create the empty output array[/COLOR]
  ReDim Info(1 To UBound(Lines) + 1, 1 To 3)
  [COLOR=#008000]' Loop through the individual lines[/COLOR]
  For X = 0 To UBound(Lines)
    [COLOR=#008000]' If the line contains the dashed number pattern, process it[/COLOR]
    If Lines(X) Like "*###-####-####*" Then
      [COLOR=#008000]' Increase the index used to write to the output file[/COLOR]
      Index = Index + 1
      [COLOR=#008000]' Loop backwards through the line (looking for the number pattern)[/COLOR]
      For Z = Len(Lines(X)) - 13 To 1 Step -1
        [COLOR=#008000]' Test each 13 characters to see if it is the number pattern[/COLOR]
        If Mid(Lines(X), Z, 13) Like "###-####-####" Then
          [COLOR=#008000]' Assign the number pattern to the middle output file element[/COLOR]
          Info(Index, 2) = Mid(Lines(X), Z, 13)
          [COLOR=#008000]' Exit loop and process the rest of the found line[/COLOR]
          Exit For
        End If
      Next
      [COLOR=#008000]' Assign the customer name to the first output file element[/COLOR]
      Info(Index, 1) = Trim(Mid(Lines(X), Z + 13))
      [COLOR=#008000]' Isolate the address from the line and assign it to the third output file element[/COLOR]
      Lines(X) = Trim(Lines(X))
      Do While Left(Lines(X), 1) = """"
        Lines(X) = Mid(Lines(X), 2)
      Loop
      Info(Index, 3) = Left(Lines(X), InStr(Lines(X), """") - 1)
    End If
  Next
  [COLOR=#008000]' Write the customer info to the active worksheet[/COLOR]
  Range("A1").Resize(Index, 3) = Info
  MsgBox "Done!"
End Sub

Rick i found that some lines in the original document are missing the address and once the code reach the first line it will stop writing the address even tho there are address after that line. please advice

 

[Rick Rothstein]

Rick i found that some lines in the original document are missing the address

What do those lines look like? Are quote marks still there, but with nothing between them? Or are they missing completely? If they are not consistent, then could you post a few lines from the file showing the way in which they are not consistent?

 

[absan]

What do those lines look like? Are quote marks still there, but with nothing between them? Or are they missing completely? If they are not consistent, then could you post a few lines from the file showing the way in which they are not consistent?

there are no quotes! its just missing for the line

 

[Rick Rothstein]

there are no quotes! its just missing for the line

Okay, see if this revised code works for you...

Sub GetCustInfo()
  Dim X As Long, Z As Long, Index As Long, FileNum As Long, Info As Variant
  Dim TotalFile As String, PathAndFileName As String, Lines() As String
  ' Get the path and filename from the user
  PathAndFileName = Application.GetOpenFilename()
  ' Get an unused file channel number
  FileNum = FreeFile
  ' The next four statements read the entire file into the TotalFile string variable
  Open PathAndFileName For Binary As #FileNum
    TotalFile = Space(LOF(FileNum))
    Get #FileNum, , TotalFile
  Close #FileNum
  ' Split the entire file into its individual lines
  Lines = Split(TotalFile, vbNewLine)
  ' Create the empty output array
  ReDim Info(1 To UBound(Lines) + 1, 1 To 3)
  ' Loop through the individual lines
  For X = 0 To UBound(Lines)
    ' If the line contains the dashed number pattern, process it
    If Lines(X) Like "*###-####-####*" Then
      ' Increase the index used to write to the output file
      Index = Index + 1
      ' Loop backwards through the line (looking for the number pattern)
      For Z = Len(Lines(X)) - 13 To 1 Step -1
        ' Test each 13 characters to see if it is the number pattern
        If Mid(Lines(X), Z, 13) Like "###-####-####" Then
          ' Assign the number pattern to the middle output file element
          Info(Index, 2) = Mid(Lines(X), Z, 13)
          ' Exit loop and process the rest of the found line
          Exit For
        End If
      Next
      ' Assign the customer name to the first output file element
      Info(Index, 1) = Trim(Mid(Lines(X), Z + 13))
      ' Isolate the address from the line and assign it to the third output file element
      Lines(X) = Trim(Lines(X))
      If Left(Lines(X), 1) = """" Then
        Do While Left(Lines(X), 1) = """"
          Lines(X) = Mid(Lines(X), 2)
        Loop
        Info(Index, 3) = Left(Lines(X), InStr(Lines(X), """") - 1)
      End If
    End If
  Next
  ' Write the customer info to the active worksheet
  Range("A1").Resize(Index, 3) = Info
  MsgBox "Done!"
End Sub

 

[absan]

Okay, see if this revised code works for you...

Hi Rick thanks the address is working great now! any idea how to do the split function int sub instead of having like 1615 MISSISSAUGA ROAD, ONW i wont the number in Cell.the street name in next cell. street type in next cell. province in next.

as of now i use Split address function which im good with but as you see not good with VBA

thanks for all the help.