Option Explicit
Dim DataTotal As Single, i As Integer, j As Integer, fs As Object
Dim LnAvrg As Integer, x_dlim As String * 1
Dim LnSkip As Integer, DateSet As Boolean, FileToOpen As String
Dim SheetRef As String, SheetRow As Integer, SheetCol As Integer, ColRef As Integer, RowRef As Integer
Dim Col_Var, x_DataVar As Integer, DataTime As String, DataAvg As Variant
Dim TxtBox, DataPreview As String
Dim File_1, File_2, File_3, File_4, File_5, File_6, File_7, File_8, File_9, File_10 As String
Private Sub Cmd_1_Click()
File_1 = Application _
.GetOpenFilename("Text Files (*.txt;*.csv), *.txt;*.csv")
Txt_1.Text = File_1
End Sub
Private Sub Cmd_10_Click()
File_10 = Application _
.GetOpenFilename("Text Files (*.txt;*.csv), *.txt;*.csv")
Txt_10.Text = File_10
End Sub
Private Sub Cmd_2_Click()
File_2 = Application _
.GetOpenFilename("Text Files (*.txt;*.csv), *.txt;*.csv")
Txt_2.Text = File_2
End Sub
Private Sub Cmd_3_Click()
File_3 = Application _
.GetOpenFilename("Text Files (*.txt;*.csv), *.txt;*.csv")
Txt_3.Text = File_3
End Sub
Private Sub Cmd_4_Click()
File_4 = Application _
.GetOpenFilename("Text Files (*.txt;*.csv), *.txt;*.csv")
Txt_4.Text = File_4
End Sub
Private Sub Cmd_5_Click()
File_5 = Application _
.GetOpenFilename("Text Files (*.txt;*.csv), *.txt;*.csv")
Txt_5.Text = File_5
End Sub
Private Sub Cmd_6_Click()
File_6 = Application _
.GetOpenFilename("Text Files (*.txt;*.csv), *.txt;*.csv")
Txt_6.Text = File_6
End Sub
Private Sub Cmd_7_Click()
File_7 = Application _
.GetOpenFilename("Text Files (*.txt;*.csv), *.txt;*.csv")
Txt_7.Text = File_7
End Sub
Private Sub Cmd_8_Click()
File_8 = Application _
.GetOpenFilename("Text Files (*.txt;*.csv), *.txt;*.csv")
Txt_8.Text = File_8
End Sub
Private Sub Cmd_9_Click()
File_9 = Application _
.GetOpenFilename("Text Files (*.txt;*.csv), *.txt;*.csv")
Txt_9.Text = File_9
End Sub
Private Sub Cmd_cancel_Click()
Unload Me
End Sub
Private Sub Cmd_ok_Click()
LnAvrg = CInt(Frm_1.Txt_LnNum_1.Value) ' Number of lines to average
x_dlim = Left(Frm_1.Txt_Dlim.Value, 1) ' The delimiter character
LnSkip = Frm_1.Txt_LnSkip ' Number of lines to skip at the beginning
SheetCol = ColRef
DateSet = False
For j = 1 To 10
If Not Frm_1.Controls("Txt_" & j).Value = "" Then
FileToOpen = Frm_1.Controls("Txt_" & j).Value
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FileExists(FileToOpen) Then
If j = 1 Then
x_DataVar = 1
GetData
SheetCol = SheetCol + 1
x_DataVar = 2
GetData
SheetCol = SheetCol + 1
Else
x_DataVar = 2
GetData
SheetCol = SheetCol + 1
End If
Else
MsgBox "File: '" & FileToOpen & "' not found.", vbOKOnly & vbExclamation
End If
End If
Next j
End Sub
Sub GetData()
Dim LineCount As Integer, LnSpool As String, SingleLine As String, x() As String
i = FreeFile
SheetRow = RowRef
Open FileToOpen For Binary Access Read As #i
If LOF(i) > 0 Then
'This loop skips a user determin number of headers
If LnSkip > 0 Then
LineCount = 0
Do
Line Input #1, LnSpool
LineCount = LineCount + 1
Loop Until EOF(i) Or LineCount = LnSkip
End If
While Not EOF(i)
DataTotal = 0
LineCount = 0
Do
Line Input #i, SingleLine
x = Split(SingleLine, x_dlim, , vbTextCompare)
' This nested If statements determin if it is time or data to be used
' When it is time, only the time from the first line is used
' When it is data it summarises the data value for the defined lines to be averaged
If x_DataVar = 1 Then
If LineCount = 0 Then DataTime = x(x_DataVar) 'This aquires the time stamp for the data set
ElseIf x_DataVar > 1 Then DataTotal = DataTotal + CSng(x(x_DataVar)) ' The Csng function is used to ensure the preservation of the decimal number, in this case as single
End If
LineCount = LineCount + 1
Loop Until EOF(i) Or LineCount = LnAvrg
' This With statement writs the read data to the spreadsheet
' using the sheet, column and row reference obtained
With ThisWorkbook.Sheets(SheetRef)
' This If statement determins if it is time or data before writing it to the cells accordingly
If x_DataVar > 1 Then DataAvg = DataTotal / LineCount Else: DataAvg = DataTime
.Cells(SheetRow, SheetCol) = DataAvg
SheetRow = SheetRow + 1
End With
Wend
End If
Close #i
End Sub
Private Sub Cmd_preview_Click()
i = FreeFile
Open File_1 For Binary Access Read As #i
If LOF(i) > 0 Then
DataPreview = ""
LineCount = 0
Do
Line Input #i, PreviewLine
DataPreview = DataPreview & PreviewLine & Chr(13)
LineCount = LineCount + 1
Loop Until EOF(i) Or LineCount = 10
End If
Close #i
Frm_2.Txt_preview.Text = DataPreview
Frm_2.Show
End Sub
Private Sub Cmd_ref_select_Click()
Dim InputCell As Excel.Range
On Error Resume Next
Frm_1.Hide
' Select the reference cell by using the inputbox method
Set InputCell = _
Application.InputBox(Prompt:="Select first input cell", _
Title:="Cell reference", Type:=8)
RowRef = InputCell.Row ' Row reference number for use when writing to the spreadsheet
ColRef = InputCell.Column ' Column reference number for use when writing to the spreadsheet
SheetRef = InputCell.Parent.Name ' Sheet name for writing to the spreadsheet
' Fill the textbox with the address of the selected reference cell
Frm_1.Txt_CellRef.Text = InputCell.Parent.Name & "!" & InputCell.Address
Frm_1.Show
End Sub
