PDA

View Full Version : Help with text file row count - only want the last 13 rows



Darth Droid
05-10-2016, 07:40 PM
Hello all, I’m new to the forum and VBA. The attached code is not all written by me,but freely available pre-existing data that almost does what I need, which isto copy a text file to my spreadsheet. What I’m additionally hoping to accomplish is the following: The text files of interest have up to 500rows, but are variable, and a new row of data is added weekly until the count reaches500, then the oldest row is deleted. I’monly interested in the last 13 rows of data, and only want the last 13 todisplay in my Excel file. Since the files’ rows can vary(</=500), I cannot just start at row 488. I’m thinking maybe there could be a procedure to always provide only thelast 13 rows via a row count deletion of all rows less than the total count -12and paste remaining last 13 rows. Any input or simpler solution isappreciated; an attachment of the current macro is included. Thanks!

SamT
05-11-2016, 09:49 AM
LastRow = theirSheet.Cells(Rows.Count, "A").End(xlUp).Row 'Edit Column to suit
StartRow = LastRow -12

TheirSheet.Range(Rows(StartRow), Rows(LastRow)).Copy MySheet.Cells(Rows.Count, "A").End(xlUp)

Darth Droid
05-11-2016, 02:30 PM
Thank you so much SamT! I can't get it to work due to my very limited VBA knowledge, but I'm sure it will work wonders if I can figure it out. Thanks again!

SamT
05-11-2016, 03:34 PM
there are a couple of issues with that.

First, I am stuck on this old laptop for now and can only open 2002 class files.

Nnext, the attached is a Word document, but you said Spreadsheet, so I gave a Spreadsheet answer.

Last, I assume the attachment is just the code you talk about. It is far better to copy the code in the VBA editor then, in our forum post editor, click the # icon to insert CODE Tags and press Ctrl+V to paste the copied code between the CODE Tags.

You can also paste the code into the Editor, Select it and press Ctrl+V.

It will post like

Sub Sample_Code()
Dim X As Boolean

X = not X

'Just a comment

If X then
MsgBox "Hello world"
End If

End Sub

Darth Droid
05-11-2016, 03:58 PM
Please forgive me and thanks again SamT, you are very helpful. I'm using Excel 2010, VBA 7.0. The original code that was on the Word document in my first post is as follows:


Sub AXJ()
'Imports the text separated by sSepChar in sSourceFile to
'Range(sTargetAddress). Overwrites any old data.
'Normally this procedure would be called by another
'passing info about the text file's name and path, separator
'(sSepChar) and maybe where to insert the text - the cell
'adress (sTargetSddress).

Dim sDel As String * 1
Dim LineString As String
Dim sSourceFile As String
Dim sSepChar As String
Dim sTargetAddress As String
Dim rTargetCell As Range
Dim vTargetValues As Variant
Dim r As Long
Dim fLen As Long
Dim fn As Integer

On Error GoTo ErrorHandle

'Text file and path
sSourceFile = "C:\Users\Al\Desktop\Daily Imports\AXJ.txt"

'Separator (delimiter)
sSepChar = ","

'Start cell for writing data
sTargetAddress = "$C$3"

'sSourceFile doesn't exist
If Len(Dir(sSourceFile)) = 0 Then Exit Sub

'Identifies the delimiter
If UCase(sSepChar) = "TAB" Or UCase(sSepChar) = "T" Then
sDel = Chr(9)
Else
sDel = Left(sSepChar, 1)
End If

'Import data
Worksheets(1).Activate

'Sets the range for the start cell
Set rTargetCell = Range(sTargetAddress).Cells(1, 1)

'Deletes any old data
rTargetCell.CurrentRegion.Clear
On Error GoTo BeforeExit

'Gets a free file number from the operating system
fn = FreeFile

'Opens the file for input
Open sSourceFile For Input As #fn
On Error GoTo 0

fLen = LOF(fn)
r = 0

While Not EOF(fn)
Line Input #fn, LineString
'Calls the function that parses the text.
vTargetValues = ParseDelimitedString(LineString, sSepChar)
'Writes to cells
UpdateCells rTargetCell.Offset(r, 0), vTargetValues
r = r + 1
Wend

'Closes the text file
Close #fn

BeforeExit:
Set rTargetCell = Nothing
Exit Sub

ErrorHandle:
MsgBox Err.Description & " Error in ImportDelimitedText."
Resume BeforeExit
End Sub



Function ParseDelimitedString(InputString As String, _
sDel As String) As Variant
'Returns a variant array with every element in
'InputString separated by sDel.

Dim i As Integer, iCount As Integer
Dim sString As String, sChar As String * 1
Dim ResultArray() As Variant

On Error GoTo ErrorHandle

sString = ""
iCount = 0

For i = 1 To Len(InputString)
sChar = Mid$(InputString, i, 1)

If sChar = sDel Then
iCount = iCount + 1
ReDim Preserve ResultArray(1 To iCount)
ResultArray(iCount) = sString
sString = ""
Else
sString = sString & sChar
End If
Next i

iCount = iCount + 1

ReDim Preserve ResultArray(1 To iCount)
ResultArray(iCount) = sString
ParseDelimitedString = ResultArray

Exit Function
ErrorHandle:
MsgBox Err.Description & " Error in function ParseDelimitedString."
End Function



Sub UpdateCells(rTargetRange As Range, vTargetValues As Variant)
'Writes the content in vTargetValues
'to the active sheet starting in rTargetRange.
'Overwrites existing data.

Dim r As Long, c As Integer

On Error GoTo ErrorHandle

If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub

r = 1
c = 1

On Error Resume Next

c = UBound(vTargetValues, 1)
r = UBound(vTargetValues, 2)

Range(rTargetRange.Cells(1, 1), rTargetRange.Cells(1, 1). _
Offset(r - 1, c - 1)).Formula = vTargetValues

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Error in procedure UpdateCells."
End Sub

Leith Ross
05-12-2016, 03:22 PM
Duplicate Post

Leith Ross
05-12-2016, 03:24 PM
Hello Darth Droid,

This macro will copy the last 13 lines of the text file (assumed to be a comma separated file) to column "C" of the active sheet starting at C3 or the next empty cell below it.



Sub AXJ_Macro()

Dim Fields As Variant
Dim File As String
Dim FileSize As Long
Dim Lines As Variant
Dim j As Long
Dim k As Long
Dim RngBeg As Range
Dim RngEnd As Range
Dim Text As String

File = "C:\Users\Al\Desktop\Daily Imports\AXJ.txt"

Set RngBeg = Range("C3")
Set RngEnd = Cells(Rows.Count, "C").End(xlUp)
If RngEnd.Row < RngBeg.Row Then Set RngEnd = RngBeg Else Set RngEnd = RngEnd.Offset(1, 0)

With CreateObject("ADODB.Stream")
.Charset = "UTF-8"
.Type = 2
.Open
.LoadFromFile = File
FileSize = .Size
Text = .ReadText
.Close
End With

If FileSize = 0 Then Exit Sub

Lines = Split(Text, vbCrLf)
If UBound(Lines) = -1 Then Lines = Array(Text)

For j = UBound(Lines) - 13 To UBound(Lines)
Fields = Split(Lines(j), ",")

If UBound(Fields) > -1 Then
RngEnd.Offset(k, 0).Resize(1, UBound(Fields) + 1).Value = Fields
Else
RngEnd.Offset(k, 0).Value = Lines(j)
End If

k = k + 1
Next j

End Sub

Darth Droid
05-12-2016, 04:01 PM
Thanks very much Leith Ross! I'm going to incorporate that with the other parts of the code and see what happens. Great forum. Thanks again! :)

Darth Droid
05-16-2016, 09:47 PM
Hello everyone,

The following code graciously submitted by Leith Ross is great, but I think I need help tweaking it (please bear with me as I am new to VBA; I have outlined my hopes below the code):


Sub AXJ_Macro()

Dim Fields As Variant
Dim File As String
Dim FileSize As Long
Dim Lines As Variant
Dim j As Long
Dim k As Long
Dim RngBeg As Range
Dim RngEnd As Range
Dim Text As String

File = "C:\Users\Al\Desktop\Daily Imports\AXJ.txt"

Set RngBeg = Range("C3")
Set RngEnd = Cells(Rows.Count, "C").End(xlUp)
If RngEnd.Row < RngBeg.Row Then Set RngEnd = RngBeg Else Set RngEnd = RngEnd.Offset(1, 0)

With CreateObject("ADODB.Stream")
.Charset = "UTF-8"
.Type = 2
.Open
.LoadFromFile = File
FileSize = .Size
Text = .ReadText
.Close
End With

If FileSize = 0 Then Exit Sub

Lines = Split(Text, vbCrLf)
If UBound(Lines) = -1 Then Lines = Array(Text)

For j = UBound(Lines) - 13 To UBound(Lines)
Fields = Split(Lines(j), ",")

If UBound(Fields) > -1 Then
RngEnd.Offset(k, 0).Resize(1, UBound(Fields) + 1).Value = Fields
Else
RngEnd.Offset(k, 0).Value = Lines(j)
End If

k = k + 1
Next j

End Sub

This does indeed return the last 13 rows from a text file with a varying number of rows. A couple hopes:

1) I would like the information to read in the Excel cells as numbers instead of "stored as text," preferably formatted to two decimal places.
2) I would like for the code to overwrite the same cell range for each time the macro is run (e.g., this code will fill Excel cells C3:N16 ... if I assign this code to a click button, I would like it to overwrite C3:N16 with the data for updates each time the button is clicked). My ultimate aim is to nest this code with others that reference a different text file on the same Excel sheet (i.e., this code will fill cells C3:N16 every time, the next nested code will fill cells C17:N30 from a different file every time, etc.)

I really appreciate any help anyone can offer, and am very thankful to SamT and Leith Ross who have offered their help so far.

GTO
05-17-2016, 06:33 AM
...This does indeed return the last 13 rows from a text file with a varying number of rows. A couple hopes:

1) I would like the information to read in the Excel cells as numbers instead of "stored as text," preferably formatted to two decimal places.
2) I would like for the code to overwrite the same cell range for each time the macro is run (e.g., this code will fill Excel cells C3:N16 ... if I assign this code to a click button, I would like it to overwrite C3:N16 with the data for updates each time the button is clicked). My ultimate aim is to nest this code with others that reference a different text file on the same Excel sheet (i.e., this code will fill cells C3:N16 every time, the next nested code will fill cells C17:N30 from a different file every time, etc.)

I really appreciate any help anyone can offer, and am very thankful to SamT and Leith Ross who have offered their help so far.

Hi there,

As you are working against smaller ranges (and presumably, not a bajillion of them), how about just a slight modification to Leith's code?



Sub AXJ_Macro()

Dim Fields As Variant
Dim File As String
Dim FileSize As Long
Dim Lines As Variant
Dim j As Long
Dim k As Long
Dim RngBeg As Range
Dim RngEnd As Range
Dim Cell As Range
Dim Text As String

File = "C:\Users\Al\Desktop\Daily Imports\AXJ.txt"

'// To always start at C3, delete...
' Set RngBeg = Range("C3")
' Set RngEnd = Cells(Rows.Count, "C").End(xlUp)
' If RngEnd.Row < RngBeg.Row Then Set RngEnd = RngBeg Else Set RngEnd = RngEnd.Offset(1, 0)

' ...and add //
Range("C3:N16").ClearContents
Set RngEnd = Range("C3")

With CreateObject("ADODB.Stream")
.Charset = "UTF-8"
.Type = 2
.Open
.LoadFromFile = File
FileSize = .Size
Text = .ReadText
.Close
End With

If FileSize = 0 Then Exit Sub

Lines = Split(Text, vbCrLf)

If UBound(Lines) = -1 Then Lines = Array(Text)

For j = UBound(Lines) - 13 To UBound(Lines)

Fields = Split(Lines(j), ",")

If UBound(Fields) > -1 Then
RngEnd.Offset(k, 0).Resize(1, UBound(Fields) + 1).Value = Fields
Else
RngEnd.Offset(k, 0).Value = Lines(j)
End If

k = k + 1
Next j

'// To correct numerical values from being considered text, add: //
For Each Cell In Range("C3:N16").Cells
If IsNumeric(Cell.Value) And Not Cell.Value = vbNullString Then
Cell.Value = CDbl(Cell.Value)
End If
Next


End Sub


I would mention that you refer to C3:N16, which is 14 rows...

Hope that helps,

Mark

Darth Droid
05-17-2016, 12:35 PM
Thanks very much GTO, I think this is going to work! I'll make a couple edits for my 14-row mistake and such, and give it a whirl! I think I owe a steak dinner or three...
Thanks again,
Alan