Reading a File? (VBA...)

[bigmc6000]

So I've got this file that I would like to read in:

R2_345678
R2_345678 0
10 lines of data...
0 .4456 1.2345 4.5 0
0.3245 0 0 0

And it repeats with stuff like that for a bunch of different "R's"

I would like to have something that checks to see if line 1 = line 2 (minus the 0) and if so then put the value into A2, go down 10 lines, read in .4456 and put that in B2, read in 1.2345 put that in C2, go down a line, read 0.3245 and put that in D2.

Repeating this process for all the R's and increasing the row each time (i.e. so I can get a list of values. The R's are names for a plate and the values I want to read in are height, width, and length...

Anybody help on this and does this make any sense?

Thanks!

 

[ChrisM]

This is certainly possible with VBA. What happens if line 1 is not equal to line 2. Do you skip down 12 lines or so to the next R's?

How much VBA experience do you have?

Will you need to be shown how to open a file in VBA?

 

[bigmc6000]

Well It's ideally gonna be in Excel for the VB not actually a VBA...

Yes - if the lines do not match I would like it to scan to next line beginning with a character (the rest of the line start with blanks or numbers).

I've made a pretty fair amount of macros in Excel so I'm really just after some syntax. I've tried using TextStream but I can't seem to get it to read the lines like I would like...

 

[ChrisM]

Can you post what you have so far using TextStream

 

[bigmc6000]

It's still a bit vague as I tend to move down my script to make sure it works before adding another part...

Sub LoadOptimization()
Dim strLine1 As String
Dim strLine2 As String
Dim fs As Object
Dim f As Object

Set fs = CreateObject("Scripting.FileSystemObject")
strFileName = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "Select The File To Read")
Set f = fs.GetFile(strFileName)

'While Not f.AtEndOfStream
strLine1 = f.ReadLine()
strLine2 = f.ReadLine()
strLine2 = f.Characters(1, 15)
If strLine1 = strLine2 Then
I = I + 1
Range("B" & I).Select

Else

End If
'Wend


End Sub


I need teh while to keep it looking until the end of the file but it doesn't seem to like the syntax there either and I have yet to put in the SkipLine command since I couldn't get the ReadLine to work...

 

[bigmc6000]

New code... I've toyed with it a bit and I've got this. Now the only thing I need to do is to be able to discern strPasteLine1 into 3 categories. Character numbers 15-20, 21-25 and 26-30. If I can get a syntax for that I should be good to go.

Thanks!!

Sub LoadOpti()
Dim FF1
Dim strLine1 As String
Dim strLine2 As String
Dim string1 As String
Dim string2 As String
Dim stringL As String
Dim stringR As String
Dim strSkip As String
Dim strPasteLine1 As String
Dim strPasteLine2 As String
Dim ts As Object
Dim f As Object

I = 1
FF1 = FreeFile()

strFileName = Application.GetOpenFilename("Text Files (*.pdb), *.txt", , "Select The File To Modify")
If strFileName = False Then Exit Sub
Open strFileName For Input As FF1

While Not EOF(FF1)
Line Input #FF1, strLine1
Line Input #FF1, strLine2

string1 = String(1, strLine1)
string2 = String(1, strLine2)
stringL = String(1, "L")
stringR = String(1, "R")

If string1 = stringL Or string1 = stringR Then
If string1 = string2 Then
I = I + 1
Range("A" & I) = strLine1
Line Input #FF1, strSkip
For j = 1 To 10
Line Input #FF1, strPasteLine1
Line Input #FF1, strPasteLine2
Next
Range("B" & I) = strPasteLine1
Range("C" & I) = strPasteLine2
End If
Else

End If
Wend


End Sub

 

[ChrisM]

Select Case strPasteLine1

Case 15 to 20
   'do this

Case 21 to 25
   'do this

Case 26 to 30
  'do this

End Select

 

[bigmc6000]

Here's what I did... Took a bit and some stuff but it worked out very very very well.

a couple of notes: the keystring is the line above the data I'm looking to pull, ClearMe is the area that the data is pasted and incase that condition doesn't have that set of data is actually the start of another set (i.e. doesn't have the keystring) it reset strLine1 and strLine2 if needed...

Sub LoadOpti()
Dim FF1
Dim strLine1, strLine2 As String
Dim string1, string2 As String
Dim stringL, stringR, stringP As String
Dim strSkip As String
Dim strPasteLine1, strPasteLine2 As String
Dim checkString, keyString As String

Application.ScreenUpdating = False

Application.Goto Reference:="ClearMe"
Selection.ClearContents

keyString = " 20 0 "

I = 1
FF1 = FreeFile()

strFileName = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "Select The File To Open")
If strFileName = False Then Exit Sub
Open strFileName For Input As FF1
On Error Resume Next

While Not EOF(FF1)
Line Input #FF1, strLine1
NextFound1:
Line Input #FF1, strLine2
NextFound2:
string1 = String(1, strLine1)
string2 = String(1, strLine2)
stringL = String(1, "L")
stringR = String(1, "R")
stringP = String(1, "P")

If string1 = stringL Or string1 = stringR Or string1 = stringP Then
If string1 = string2 Then
I = I + 1
Range("A" & I) = strLine1
Line Input #FF1, strSkip
strPasteLine1 = String(2, 1)

Do While strPasteLine1 <> keyString
Line Input #FF1, strPasteLine1
Loop

Line Input #FF1, strPasteLine1
Line Input #FF1, strPasteLine2

checkstring1 = String(1, strPasteLine1)
checkstring2 = String(1, strPasteLine2)

If checkstring1 = stringL Or checkstring1 = stringR Or checkstring1 = stringP Then
strLine1 = strPasteLine1
strLine2 = strPasteLine2
GoTo NextFound2
End If

If checkstring2 = stringL Or checkstring2 = stringR Or checkstring2 = stringP Then
strLine1 = strPasteLine1
GoTo NextFound1
End If

If checkString = stringL Or checkString = stringR Or checkString = stringP Then
GoTo NotOptimized
End If

If Val(Mid(strPasteLine1, 2, 1)) = 0 Then
GoTo NoPaste
End If

Range("B" & I) = Mid(strPasteLine1, 2, 2)
Range("C" & I) = Mid(strPasteLine1, 16, 6)
Range("D" & I) = Mid(strPasteLine1, 30, 6)
Range("E" & I) = Mid(strPasteLine1, 44, 6)
Range("F" & I) = Mid(strPasteLine2, 2, 8)
Range("G" & I) = Mid(strPasteLine2, 16, 8)
Range("H" & I) = Mid(strPasteLine2, 30, 8)
Range("I" & I) = Mid(strPasteLine2, 43, 8)
NoPaste:
End If
Else

End If
NotOptimized:
Wend
EndReached:
On Error GoTo 0

Range("A1").Select
Application.ScreenUpdating = True
End Sub

 

[bigmc6000]

One more note - I am only looking for conditions that start with L, R, or P - hence the stringL, stringR, and stringP vars...