Search Word for text and send values next to text to Excel file

F

fordma2831

New Member
Joined
Apr 29, 2009
Messages
13
This is my first post and I am not certain that I have exhausted the search function on the board, but I was hoping someone could point me in the right direction. <?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:eek:ffice:eek:ffice" /><o:p></o:p>
<o:p></o:p>
I am using Windows XP and Office 2003. <o:p></o:p>
<o:p></o:p>
I am looking to automate a process where information is sent to someone in a text format and they in turn transfer that data to an excel file. It basically looks like this (but includes a lot more info):<o:p></o:p>
<o:p></o:p>
Service Request #: 123456<o:p></o:p>
Instrument Type: New Instrument<o:p></o:p>
Lot/Serial #: 123456<o:p></o:p>
SR Type: Product Complaint<o:p></o:p>
Service Coverage: Maintenance Agreement<o:p></o:p>
<o:p></o:p>
The info on the left (text preceding the colon) is always the same but the values following the colon can change. The excel file has all of the text before the colon and they just enter the information into the cells. I am looking to make it so that an Excel macro (or maybe a word/outlook macro) automatically scans the text document and sends this info to the exact same cells in excel every time. <o:p></o:p>
<o:p></o:p>
The text file is actually a message from an Oracle database and I am not going to be able to make any changes to the way the data comes in. <o:p></o:p>
<o:p></o:p>
My only real experience with VBA is from recording macros and looking at them in the editor. I did just pick up a book though...<o:p></o:p>
<o:p></o:p>
Does this seem feasible? <o:p></o:p>
<o:p></o:p>
Thanks for the help. <o:p></o:p>
<o:p></o:p>
Matt <o:p></o:p>
 
Sort by date Sort by votes
Assuming you have already created the headings in col.A without ":"
Rich (BB code): 
Sub test()
Dim fn As String, temp As String, i As Long, r As Range
fn = "c:\test.txt"     '<- file path
temp = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
With CreateObject("Scripting.Dictionary")
    .Comparemode = vbTextCompare
    For Each e In Split(temp, vbCrLf)
        .item(Split(e, ":")(0)) = Split(e, ":")(1)
    Next
    a = Range("a1", Range("a" & Rows.Count).End(xlUp)).Resize(, 2).Value
    For i = 1 To UBound(a, 1)
        a(i, 2) = ""
        If .exists(a(i, 1)) Then a(i, 2) = .item(a(i, 1))
    Next
    Range("a1").Resize(UBound(a, 1), 2).Value = a
End With
End Sub
 
Upvote 0

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Seiya said:
Assuming you have already created the headings in col.A without ":"
Rich (BB code): 
Sub test()
Dim fn As String, temp As String, i As Long, r As Range
fn = "c:\test.txt"     '<- file path
temp = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
With CreateObject("Scripting.Dictionary")
    .Comparemode = vbTextCompare
    For Each e In Split(temp, vbCrLf)
        .item(Split(e, ":")(0)) = Split(e, ":")(1)
    Next
    a = Range("a1", Range("a" & Rows.Count).End(xlUp)).Resize(, 2).Value
    For i = 1 To UBound(a, 1)
        a(i, 2) = ""
        If .exists(a(i, 1)) Then a(i, 2) = .item(a(i, 1))
    Next
    Range("a1").Resize(UBound(a, 1), 2).Value = a
End With
End Sub
Click to expand...


I am getting subscript out of range for line-

.Item(Split(e, ":")(0)) = Split(e, ":")(1)

Here is what I did:

I created a text file with the information in my original post and saved it as test.txt in the C directory. I then opened an Excel file and put the same words, without ":" in column a. Column B is blank. I opened the VBA editor and put your code in as a module in that workbook and saved is as texttest.
 
Upvote 0
That means you have line(s) with no ":"
Rich (BB code): 
Sub test()
Dim fn As String, temp As String, i As Long, r As Range
fn = "c:\test.txt"     '<- file path
temp = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
With CreateObject("Scripting.Dictionary")
    .Comparemode = vbTextCompare
    For Each e In Split(temp, vbCrLf)
        If InStr(e, ":") > 0 Then .item(Split(e, ":")(0)) = Split(e, ":")(1)
    Next
    a = Range("a1", Range("a" & Rows.Count).End(xlUp)).Resize(, 2).Value
    For i = 1 To UBound(a, 1)
        a(i, 2) = ""
        If .exists(a(i, 1)) Then a(i, 2) = .item(a(i, 1))
    Next
    Range("a1").Resize(UBound(a, 1), 2).Value = a
End With
End Sub
 
Upvote 0
Seiya said:
That means you have line(s) with no ":"
Rich (BB code): 
Sub test()
Dim fn As String, temp As String, i As Long, r As Range
fn = "c:\test.txt"     '<- file path
temp = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
With CreateObject("Scripting.Dictionary")
    .Comparemode = vbTextCompare
    For Each e In Split(temp, vbCrLf)
        If InStr(e, ":") > 0 Then .item(Split(e, ":")(0)) = Split(e, ":")(1)
    Next
    a = Range("a1", Range("a" & Rows.Count).End(xlUp)).Resize(, 2).Value
    For i = 1 To UBound(a, 1)
        a(i, 2) = ""
        If .exists(a(i, 1)) Then a(i, 2) = .item(a(i, 1))
    Next
    Range("a1").Resize(UBound(a, 1), 2).Value = a
End With
End Sub
Click to expand...

It moved the words over! Thanks Seiya! Is there a reason why the numbers next to service request and next to serial number didn't transfer?

This is a huge help! Thanks again.
 
Upvote 0
try this
Rich (BB code): 
Sub test()
Dim fn As String, temp As String, i As Long, r As Range
fn = "c:\test.txt"     '<- file path
temp = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
With CreateObject("Scripting.Dictionary")
    .Comparemode = vbTextCompare
    For Each e In Split(temp, vbCrLf)
        If InStr(e, ":") > 0 Then .item(Trim(Split(e, ":")(0))) = Split(e, ":")(1)
    Next
    a = Range("a1", Range("a" & Rows.Count).End(xlUp)).Resize(, 2).Value
    For i = 1 To UBound(a, 1)
        a(i, 2) = ""
        If .exists(Trim(a(i, 1))) Then a(i, 2) = .item(Trim(a(i, 1))) : .remove a(i, 1)
    Next
    Range("a1").Resize(UBound(a, 1), 2).Value = a
    If .count > 0 Then
        MsgBox "Following field have no match in Col.A" & vbLf & _
            Join$(.keys, vbLf) & vbLf & "Check extra space or something"
    End If
End With
End Sub
 
Upvote 0
Seiya said:
try this
Rich (BB code): 
Sub test()
Dim fn As String, temp As String, i As Long, r As Range
fn = "c:\test.txt"     '<- file path
temp = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
With CreateObject("Scripting.Dictionary")
    .Comparemode = vbTextCompare
    For Each e In Split(temp, vbCrLf)
        If InStr(e, ":") > 0 Then .item(Trim(Split(e, ":")(0))) = Split(e, ":")(1)
    Next
    a = Range("a1", Range("a" & Rows.Count).End(xlUp)).Resize(, 2).Value
    For i = 1 To UBound(a, 1)
        a(i, 2) = ""
        If .exists(Trim(a(i, 1))) Then a(i, 2) = .item(Trim(a(i, 1))) : .remove a(i, 1)
    Next
    Range("a1").Resize(UBound(a, 1), 2).Value = a
    If .count > 0 Then
        MsgBox "Following field have no match in Col.A" & vbLf & _
            Join$(.keys, vbLf) & vbLf & "Check extra space or something"
    End If
End With
End Sub
Click to expand...


I am getting a syntax error with the msgbox line. I actually loaded some new infomation into test.txt file, then I reran your last macro and it imported everything perfectly! Not really sure what it is having a problem with the message line version though.
 
Upvote 0
Are you sure that your lines look like
Rich (BB code): 
    If .count > 0 Then
        MsgBox "Following field have no match in Col.A" & vbLf & _
            Join$(.keys, vbLf) & vbLf & "Check extra space or something"
    End If

That was Y before I edited.
 
Upvote 0
Seiya said:
Are you sure that your lines look like
Rich (BB code): 
    If .count > 0 Then
        MsgBox "Following field have no match in Col.A" & vbLf & _
            Join$(.keys, vbLf) & vbLf & "Check extra space or something"
    End If

That was Y before I edited.
Click to expand...

The message box works now. It is saying that they have no match but it is actually returning all of the fields. So, it is doing everything that I am looking for it to do- which is great! Thanks!

I am going to look at adding some more macros to deal with everything else (creating the text file from Outlook and transferrign the excel data to the final form) but this was definitley the heavy lifting for me. Thanks again Seiya!

Matt
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
Excel file search engine
Replies
6
Views
385
6StringJazzer
6StringJazzer
D
  • Question
Create empty table (with headings) in Word document after some text
Replies
5
Views
227
dwsteyl
D
L
  • Question
VBA Import all lines of data from a variable text file
Replies
3
Views
575
rlv01
R
Y
  • Solved
Highlighting selected words in a column.
Replies
6
Views
280
Akuini
Akuini
A
  • Question
Help with scanning barcodes into an excel invoice
2
Replies
12
Views
775
RoryA
RoryA

Forum statistics

Threads
1,216,416
Messages
6,130,486
Members
449,584
Latest member
LeChuck

Share this page

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
Back
Top