LearnVBA83
Board Regular
- Joined
- Dec 1, 2016
- Messages
- 109
- Office Version
- 365
- Platform
- Windows
Hi VBASuperUsers,
With the growing knowledge I have on VBA along with great help from the forum, I've completed the below coding that will open my text file in excel and format the way I need it. My next obstacle is getting this code to Loop through a folder with multiple txt files and convert them to excel and save them in that folder or another folder. Is this even possible? Ideally I would like to have the code changed so that I click a button and it asks me what folder to choose with the text files. I choose that folder and it loops through and coverts all of the txt files to excel and does my formatting code and saves them. Any help would be greatly appreciated!!! Thanks you all for the wonderful help in the past.
With the growing knowledge I have on VBA along with great help from the forum, I've completed the below coding that will open my text file in excel and format the way I need it. My next obstacle is getting this code to Loop through a folder with multiple txt files and convert them to excel and save them in that folder or another folder. Is this even possible? Ideally I would like to have the code changed so that I click a button and it asks me what folder to choose with the text files. I choose that folder and it loops through and coverts all of the txt files to excel and does my formatting code and saves them. Any help would be greatly appreciated!!! Thanks you all for the wonderful help in the past.
Code:
Option Explicit
Sub ImportTextFile()
Dim fName As String
fName = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If fName = "False" Then Exit Sub
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fName, _
Destination:=Range("$A$1"))
.Name = "sample"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(14, 13, 13, 14, 17, 10, 26, 5, 8)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
'Add Lockbox to File
With Range("K2:K" & Range("I" & Rows.Count).End(xlUp).Row)
.FormulaR1C1 = "=if(r[-1]c[-2]=""PAGE"",rc[-5],if(rc[-2]=""PAGE"","""",r[-1]c))"
.Value = .Value
End With
'Add Date to File
With Range("L2:L" & Range("I" & Rows.Count).End(xlUp).Row)
.FormulaR1C1 = "=if(r[-1]c[-3]=""PAGE"",rc[-10],if(rc[-2]=""PAGE"","""",r[-1]c))"
.Value = .Value
End With
'Delete Blank Rows using column H
On Error Resume Next
Columns("H").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'check for filter, turn on if none exists
If Not ActiveSheet.AutoFilterMode Then
ActiveSheet.Range("A1").AutoFilter
End If
ActiveSheet.Range("$A$1:$A$1000000").AutoFilter Field:=1, Criteria1:= _
"=*CHK NB*", Operator:=xlAnd
ActiveSheet.Range("A2:M1000000").Select
Selection.SpecialCells(xlCellTypeVisible).EntireRow.Delete
ActiveSheet.Range("A1").AutoFilter = False
On Error Resume Next
'Replace OX with nothing and : in the date with nothing
Columns("K").Replace What:="OX ", _
Replacement:="", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
Columns("L").Replace What:=": ", _
Replacement:="", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
ActiveSheet.Range("K1").Value = "Lock Box"
ActiveSheet.Range("L1").Value = "Deposit Date"
ActiveSheet.Range("G:G").NumberFormat = "0"
ActiveSheet.Cells.EntireColumn.AutoFit
End Sub
