vba code to open text files in excel with delimiter as "`"

[vishal.bht]

Hi,

I wish to open text files i excel usign VBA with a delimiter as ~....I dont know how do we refer to the Other delimiter option...Following is my code

Private Sub CommandButton1_Click()
Dim varFileName
varFileName = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If TypeName(varFileName) = "String" Then
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & varFileName _
, Destination:=Range("A1"))
.Name = "AddEmployee"
.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 = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = False
.TextFileOtherDelimiter = True
.Refresh BackgroundQuery:=False
End With
End If
End Sub
Can neone please help

Rgds
Vishal

 

[Joe4]

Trying changing

.TextFileOtherDelimiter = True

to

.TextFileOtherDelimiter = "~"

 

[vishal.bht]

Thanks..it works fine. but em running into one more problem here...i am importing a text file with some records..it has some decimal fields defined as decimal (5,2) and decimal(15,2)...I have two questions if you can please help

1. When importing if the text file has a record in the format 04.000, gets imported to excel as 4...can i get it in the same format as in text file

2. How can we check in excel the legnth of the a field if it is a decimal..say if 04.000 gets imported to excel..is there a way in excel we can validate it to be decimal(5,2)

Thanks
Vishal

 

[Joe4]

Sorry for the delay in replying. I was away all of last week.

I am not sure how to do exactly what you want. It might require writing a bit of complex VBA, maybe some UDFs (User Defined Functions).

However, it should be noted that changing the format of a number in Excel does NOT change how the value is stored in Excel, just it's appearance. So even if you formatted 4 as a number with two decimals so that it appears as 4.00, Excel still stores it as 4.

If you want to maintain the way it "looks" in the text file, you can import it as a Text field instead of a numeric field. Of course, you may not want to do that if you are planning on using these numbers in computations.

Perhaps a little more detail about what exactly you will be doing with this data would shed some light on the problem and spark some ideas on getting the end results you are after...

 

[vishal.bht]

Hi..Thanks for ur help..it worked..howevr, i m running into one more problem now..let me state my work first...I am importing a text file into excel as delimited and checking the format of the imported rows and columns..there are three format checks.

1. Character format : I was checking it using the legnth of the field..for e.g. if the field is a char(6) format then i m checking it as
If Len(cell.Value) > 6 Then Worksheets("Review").Range("D5").Value = "FAIL" Else Worksheets("Review").Range("D5").Value = "PASS"this is not working for me..even if i pass a field having legnt more than 6 the result is going in as pass..

2. Date format: this is working fine

3. decimal format : not very much sure how to check this....

can u please help with the 1st issue...thx..i hv posted my code below

Private Sub CommandButton1_Click()
Dim varFileName
Dim lastrow As Long
Dim cell As Range
Dim xlrng As Range
Dim xlrng1 As Range
varFileName = Application.GetOpenFilename("Text Files (*.txt), *.txt")
Sheets("Asset").Range("A3:DQ1000").Clear
'Sheets("Review").Range("A1:DQ1000").Clear
If TypeName(varFileName) = "String" Then
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & varFileName _
, Destination:=Range("A3"))
.Name = "Extract"
.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 = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
.TextFileOtherDelimiter = "~"
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False

' lastrow = Sheets("Asset").Cells(Rows.Count, 1).End(xlUp).Row
'Set xlrng = Sheets("Asset").Range("M4:M" & lastrow)
'For Each cell In xlrng
' cell.NumberFormat = "0#.000"
'Next cell

lastrow = Sheets("Asset").Cells(Rows.Count, 1).End(xlUp).Row
Set xlrng = Sheets("Asset").Range("A4:A" & lastrow)
For Each cell In xlrng
If Len(cell.Value) > 6 Then Worksheets("Review").Range("D5").Value = "FAIL" Else Worksheets("Review").Range("D5").Value = "PASS"
' MsgBox Len(cell.Value)
Next cell

Set xlrng = Sheets("Asset").Range("B4:B" & lastrow)
For Each cell In xlrng
If Len(cell.Value) <= 8 Then Worksheets("Review").Range("D6").Value = "PASS" Else Worksheets("Review").Range("D6").Value = "FAIL"
Next cell
Set xlrng = Sheets("Asset").Range("C4:C" & lastrow)
For Each cell In xlrng
If Len(cell.Value) <= 6 Then Worksheets("Review").Range("D7").Value = "PASS" Else Worksheets("Review").Range("D7").Value = "FAIL"
Next cell
Set xlrng = Sheets("Asset").Range("D4:D" & lastrow)
For Each cell In xlrng
If Len(cell.Value) <= 6 Then Worksheets("Review").Range("D8").Value = "PASS" Else Worksheets("Review").Range("D8").Value = "FAIL"
Next cell
Set xlrng = Sheets("Asset").Range("E4:E" & lastrow)
For Each cell In xlrng
If Len(cell.Value) <= 6 Then Worksheets("Review").Range("D9").Value = "PASS" Else Worksheets("Review").Range("D9").Value = "FAIL"
Next cell
Set xlrng = Sheets("Asset").Range("F4:F" & lastrow)
For Each cell In xlrng
If Len(cell.Value) <= 6 Then Worksheets("Review").Range("D10").Value = "PASS" Else Worksheets("Review").Range("D10").Value = "FAIL"
Next cell
Set xlrng = Sheets("Asset").Range("G4:G" & lastrow)
For Each cell In xlrng
If Len(cell.Value) <= 6 Then Worksheets("Review").Range("D11").Value = "PASS" Else Worksheets("Review").Range("D11").Value = "FAIL"
Next cell



Range("A4").Select
Range(Selection, Selection.End(xlToRight)).Select
'Range(Selection, Selection.End(xlRight)).Select
'MsgBox TypeName(Range("A4").Value)
Selection.Copy
' MsgBox Len(Range("M4").Value)
Worksheets("Review").Range("C124").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True


End With
End If
End Sub

I have removed some part of the code as it was quite legnthy....the part removed is format check only

 

[vishal.bht]

I identified the problem but cannot find the solution....the objective is to check a complete row say ("A1:A300") for the legnth of the values in these cells..whenever the legnth of any value in these cells exceed 6 it should update another sheet "Review" cell as Fail else it should update it as Pass...with the current logic it is traversing all the records..but i think it is considering only the last value where it stops and compares it...if in between it would find any legnth greater than 6 that would be ignored...i want between A1 to A300 if the legnth of any value exceeds 6 it should be falied...could anybody pls help ...thx in advance

 

[Joe4]

Your code is very hard to read, please use code tags so it is easier to follow (like I have below).

I extracted a part of your code, and split up the IF...THEN...ELSE clause into multiple lines so that it is easier to read.

lastrow = Sheets("Asset").Cells(Rows.Count, 1).End(xlUp).Row
Set xlrng = Sheets("Asset").Range("A4:A" & lastrow)
For Each cell In xlrng
    If Len(cell.Value) > 6 Then 
        Worksheets("Review").Range("D5").Value = "FAIL" 
    Else    
        Worksheets("Review").Range("D5").Value = "PASS"
    End If
Next cell

I am not sure if this is what you really want. This loops through all your cells in range A4 to the end of column A, but it is always updating Range("D5") on the Review sheet. So your values in D5 keep getting overridden by the succeeding one, and you are only left with the last one.

Is that really what you are intending to do?

 

[vishal.bht]

Hi,

What I am trying to do is...that a text file would be imported to excel and I want to check the format of the imported records..in a nutshell it would check all the records in range (A:A) and if the legnth of any cell is more than 6 it would record a FAIL in D6 else it would record a PASS in D6..

Hope I made my point clear

 

[Joe4]

it would check all the records in range (A:A) and if the legnth of any cell is more than 6 it would record a FAIL in D6 else it would record a PASS in D6..

So, it sounds to me that as soon as you find one bad record, you want to stop the loop and record the "FAIL". Otherwise, if you continued on, you might have some good records after the bad one which would put a "PASS" in there and overwrite the "FAIL".

So, I think you would want to update the code to exit that particular loop as soon as you find one "FAIL". You can use "Exit For" to accomplish this, i.e.

lastrow = Sheets("Asset").Cells(Rows.Count, 1).End(xlUp).Row
Set xlrng = Sheets("Asset").Range("A4:A" & lastrow)
For Each cell In xlrng
    If Len(cell.Value) > 6 Then 
        Worksheets("Review").Range("D5").Value = "FAIL" 
        Exit For
    Else    
        Worksheets("Review").Range("D5").Value = "PASS"
    End If
Next cell

Repeat this logic for each section of code where you are recording "FAIL"s.

I think I would probably go about it a little differently. I would default it to "PASS" and then have the loop write "FAIL" if a failed instance is found and then exit the loop. It is a little more efficient, as you are not constantly updating D5 with every cell you check. That code would look something like this:

lastrow = Sheets("Asset").Cells(Rows.Count, 1).End(xlUp).Row
Set xlrng = Sheets("Asset").Range("A4:A" & lastrow)
Worksheets("Review").Range("D5").Value = "PASS"
For Each cell In xlrng
    If Len(cell.Value) > 6 Then 
        Worksheets("Review").Range("D5").Value = "FAIL" 
        Exit For
    End If
Next cell