Hello,
I recorded the macro to import large text file but unable to align it to cells, I need this macro to import text file on regular basis and create a summary of it.
Please some one help with macro to import and create summary from it. The sample text and excel workbook is attached.
Thanks in advance.
Question posted in other forum link: http://windowssecrets.com/foru…t-File-and-Create-Summary
Re: Create Summary and Report from text file
Output in Summary sheet
Sub test()
Dim fn As String, txt, m, n As Long, temp, a(), x, myArea
fn = Application.GetOpenFilename("TextFiles,*.txt")
If fn = "False" Then Exit Sub
n = 1: ReDim a(1 To 1): a(n) = Array("Area", "Records", "Amunt"):
txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
With CreateObject("VBScript.RegExp")
.Global = True: .MultiLine = True: .IgnoreCase = True
.Pattern = "^\| *Location (Code|Total) *: *(?:[^:]+:)? *(\d+) *\|? *(\S.*\d+|[\d,\.]+) *.*$"
For Each m In .Execute(txt)
Set x = m.submatches
If x(0) = "Code" Then
n = n + 1
ReDim Preserve a(1 To n)
myArea = x(2)
Else
a(n) = Array(myArea, x(1), Replace(x(2), ",", ""))
End If
Next
End With
With Sheets("summary").[a1].Resize(n, 3)
.CurrentRegion.ClearContents
.Value = Application.Index(a, 0, 0)
.Rows(.Rows.Count + 1).Range("b1:c1").Formula = "=sum(r2c:r[-1]c)"
.Columns(3).Resize(n + 1).NumberFormat = "#.00"
.Columns.AutoFit
End With
End SubRe: Create Summary and Report from text file
MODERATOR NOTICE: This topic has also been posted on other sites and may already have an answer elsewhere. Please take this into consideration when answering this question
*
Re: Create Summary and Report from text file
Hello,
Cytop, I apologize & updated the first post.
Jindon, Thanks for creation of summary, I am highly obliged. Please can i have the details of text file also in excel sheet for details cross check.
The details are not getting formatted / aligned in cells with option Data-->From Text if i import.
The Details Report is also required.
Thanks in advance.
Re: Create Summary and Report from text file
How do you want it?
Re: Create Summary and Report from text file
Quote from jindon;758302How do you want it?
Thankyou Jindon for the response.
I requested for details report, requirement is described in sheet1 of Test.xls.
If possible please get the details report in sheet1 from text file along with summary in sheet2.
Attached Test.xls.
Thanks in advance.
Re: Create Summary and Report from text file
See if this is how you wanted.
Option Explicit
Sub myReport()
Dim fn As String, txt, m, n As Long, temp, a(), x, myArea
fn = Application.GetOpenFilename("TextFiles,*.txt")
If fn = "False" Then Exit Sub
n = 1: ReDim a(1 To 1): a(n) = Array("Area", "Records", "Amunt"):
txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
temp = txt
With CreateObject("VBScript.RegExp")
.Global = True: .MultiLine = True: .IgnoreCase = True
.Pattern = "^\| *Location (Code|Total) *: *(?:[^:]+:)? *(\d+) *\|? *(\S.*\d+|[\d,\.]+) *.*$"
For Each m In .Execute(txt)
Set x = m.submatches
If x(0) = "Code" Then
n = n + 1
ReDim Preserve a(1 To n)
myArea = x(2)
Else
a(n) = Array(myArea, x(1), Replace(x(2), ",", ""))
End If
Next
End With
With Sheets("summary").[a1].Resize(n, 3)
.CurrentRegion.ClearContents
.Value = Application.Index(a, 0, 0)
.Rows(.Rows.Count + 1).Range("b1:c1").Formula = "=sum(r2c:r[-1]c)"
.Columns(3).Resize(n + 1).NumberFormat = "#.00"
.Columns.AutoFit
End With
myQuery temp
End Sub
Private Sub myQuery(ByVal txt As String)
Dim fn As String, a(), x, y, i As Long, ii As Long, maxCol As Long
txt = Mid$(txt, InStr(txt, "|"))
With CreateObject("VBScript.RegExp")
.Global = True: .MultiLine = True: .IgnoreCase = True
.Pattern = "^\|[=-]+\|[\r\n]+|^\| *(?=Location *)"
txt = .Replace(txt, "")
.Pattern = "Location"
txt = Mid$(txt, .Execute(txt)(0).firstindex + 1)
End With
x = Split(txt, vbCrLf): ReDim a(1 To UBound(x) + 1, 1 To 100)
For i = 0 To UBound(x)
x(i) = LTrim$(RTrim$(x(i)))
If x(i) <> "" Then
y = Split(x(i), "|")
maxCol = Application.Max(maxCol, UBound(y) + 1)
If UBound(a, 2) < maxCol Then
ReDim Preserve a(1 To UBound(a, 1), 1 To maxCol)
End If
For ii = 0 To UBound(y)
a(i + 1, ii + 1) = y(ii)
Next
End If
Next
With Sheets("sheet1").[a1].Resize(, maxCol)
.Parent.Cells.ClearContents
.Cells(1).Value = "RUN DATE :" & Date
.Offset(1).Resize(UBound(a, 1)).Value = a
End With
End SubRe: Create Summary and Report from text file
Hi,
Sorry for delay reply.
Thanks Jindon for the script.
Jindon, on testing in summary suppose row of Location Total is empty then report gets corrupted. Please provide a solution.
Quote
|-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------|
| Location Total : No of Records : | | |
|-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------|
This date to be appended from text file first line dd/mm/yyyy.
Thanks in advance.
Re: Create Summary and Report from text file
Run date issue.
Private Sub myQuery(ByVal txt As String)
Dim fn As String, a(), x, y, i As Long, ii As Long, maxCol As Long, myDate As String
With CreateObject("VBScript.RegExp")
.Global = True: .MultiLine = True: .IgnoreCase = True
.Pattern = "RUN DATE.*"
If .test(txt) Then myDate = .Execute(txt)(0)
txt = Mid$(txt, InStr(txt, "|"))
.Pattern = "^\|[=-]+\|[\r\n]+|^\| *(?=Location *)"
txt = .Replace(txt, "")
.Pattern = "Location"
txt = Mid$(txt, .Execute(txt)(0).firstindex + 1)
End With
x = Split(txt, vbCrLf): ReDim a(1 To UBound(x) + 2, 1 To 100)
For i = 0 To UBound(x)
x(i) = LTrim$(RTrim$(x(i)))
If x(i) <> "" Then
y = Split(x(i), "|")
maxCol = Application.Max(maxCol, UBound(y) + 1)
If UBound(a, 2) < maxCol Then
ReDim Preserve a(1 To UBound(a, 1), 1 To maxCol)
End If
For ii = 0 To UBound(y)
a(i + 1, ii + 1) = y(ii)
Next
End If
Next
With Sheets("sheet1").[a1].Resize(, maxCol)
.Parent.Cells.ClearContents
.Cells(1).Value = myDate
.Offset(1).Resize(UBound(a, 1)).Value = a
End With
End SubUpload a txt file, I only work with uploaded file.
Re: Create Summary and Report from text file
Quote from jindon;758607
Upload a txt file, I only work with uploaded file.
Text file uploaded for testing i have made rows empty.
Quote
Location Code : 2 Area Remote 1
Location Total : No of Records :
Location Code : 400 Area Remote 3
Location Total : No of Records :
Runtime error '13:' Type mismatch.
Please have a look.
Re: Create Summary and Report from text file
Changeg "myReport" to
Sub myReport()
Dim fn As String, txt, m, n As Long, temp, a(), x, w, myArea
fn = Application.GetOpenFilename("TextFiles,*.txt")
If fn = "False" Then Exit Sub
n = 1: ReDim a(1 To 1): a(n) = Array("Area", "Records", "Amunt"):
txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
temp = txt
With CreateObject("VBScript.RegExp")
.Global = True: .MultiLine = True: .IgnoreCase = True
.Pattern = "^\| *Location (Code|Total) *: *(?:[^:]+:)? *(\d+) *\|? *(\S.*\d+|[\d,\.]+) *.*$"
For Each m In .Execute(txt)
Set x = m.submatches
If x(0) = "Code" Then
n = n + 1
ReDim Preserve a(1 To n)
a(n) = VBA.Array(x(2), Empty, Empty)
Else
w = a(n): w(1) = x(1): w(2) = Replace(x(2), ",", "")
a(n) = w
End If
Next
End With
With Sheets("summary").[a1].Resize(n, 3)
.CurrentRegion.ClearContents
.Value = Application.Index(a, 0, 0)
.Rows(.Rows.Count + 1).Range("b1:c1").Formula = "=sum(r2c:r[-1]c)"
.Columns(3).Resize(n + 1).NumberFormat = "#.00"
.Columns.AutoFit
End With
myQuery temp
End SubDon’t have an account yet? Register yourself now and be a part of our community!