Specific Macros

  • Thread starter Thread starter Biochemist
  • Start date Start date
B

Biochemist

I would like to know how to write a specific macro that handles the following
format:
download a series of alpha and numbers, the alpha values are always second
in the location, example would be
Cell A1 = 10102007 truckstop $15.32 $4449.31
Cell A2 = 95102007 office stop store center $22.32 $3465.89
I would like to have the macro able to place dates into A column dates, B
column vendor name, C column the first $ value, and in the D column the last
$ value, and have this run for the complete spreadsheet.
Thanks in advance
 
Turn the macro recorder on, do a Data>Text To Columns with a space
delimiter, this will give you the code.

--
---
HTH

Bob


(there's no email, no snail mail, but somewhere should be gmail in my addy)
 
I am sorry can you give me more information as I am new to using macro and
the recorder, thanks
 
Sub Gettext()

Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const TxtDirectory = "C:\temp\"
Const ReadFileName = "test.txt"
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

Set fsread = CreateObject("Scripting.FileSystemObject")
ReadPathName = TxtDirectory + ReadFileName
Set fread = fsread.GetFile(ReadPathName)
Set tsread = fread.OpenAsTextStream(ForReading, TristateUseDefault)

RowCount = 1
Do While tsread.atendofstream = False

InputLine = Trim(tsread.Readline)

NewDate = Trim( _
Left(InputLine, InStr(InputLine, " ") - 1))
NewDate = Left(NewDate, 2) & "/" & Mid(NewDate, 3, 2) & _
"/" & Mid(NewDate, 5, 4)
NewDate = DateValue(NewDate)
InputLine = Trim( _
Mid(InputLine, InStr(InputLine, " ") + 1))
Vendor = Trim(Left(InputLine, InStr(InputLine, "$") - 1))
InputLine = Trim( _
Mid(InputLine, InStr(InputLine, "$") + 1))
Firstamount = Val(Trim( _
Left(InputLine, InStr(InputLine, "$") - 1)))
SecondAmount = Val(Trim( _
Mid(InputLine, InStr(InputLine, "$") + 1)))
Range("A" & RowCount) = NewDate
Range("B" & RowCount) = Vendor
Range("C" & RowCount) = Firstamount
Range("D" & RowCount) = SecondAmount

RowCount = RowCount + 1
Loop
tsread.Close

End Sub
 
Sub Format_Report()

With Sheets("Sheet1")
.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = "NewSheet"
End With
With Sheets("NewSheet")
RowCount = 1
Do While .Range("C" & RowCount) <> ""
Data = .Range("C" & RowCount)
With Sheets("LookupSheet")
Set c = .Columns("D:D").Find(what:=Data, _
LookIn:=xlValues)
If Not c Is Nothing Then
Newdata = c.Offset(rowoffset:=0, columnoffset:=1)
Sheets("NewSheet").Range("C" & RowCount) = Newdata
End If
End With

RowCount = RowCount + 1
Loop
End With
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Back
Top