vba help - extract value from text

[Mallesh23]

Hi Team,

Below is my data in txt file,
Task is Copy Currency, Period and Buy Type: if nothing is mentioned infront of it Consider (zero value)

There are around 200 lines of data , I have to find and get value.


These 3 lines are sample from txt file , Ignore Blank lines
Currency : USD Period : ABC+PQR Buy Type: Manual

Currency : INR Period : ABC+PQR Buy Type:
Currency : AUD Period : -------- Buy Type: AAA,BBB CCC DDD HHH


Below is expected Value

Currency	Period	Buy Type
USD	ABC+PQR	Manual
INR	ABC+PQR	0
AUD	--------	AAA,BBB CCC DDD HHH

Thanks
mg

 

[Dan_W]

Hi Mallesh - 200 lines of data sounds like quite a task. What have you tried so far?

 

[Mallesh23]

Hi Dan,
I am using instr finding specific position, or mid , left right. Its big task solving step by step.
my data is in office laptop.

pos = instr(1,str("Currency:")
pos = instr(1,str("Buy Type:")
pos = instr(1,str("Period:")

Below is sample code I am referring, I will modify as per my accordance,
Sub ImportDataFromTextFile()
Dim T As New clsText
Dim S As New clsSales
Dim Rng As Range
Workbooks.Add


FilePath = ThisWorkbook.Path & "\041 - Data.txt"

With T
.OpenTextRO FilePath

Do Until .ReadLine = False
If InStr(.CurrentLine, "Customer ID: ") > 0 Then
S.CustomerID = Replace(.CurrentLine, "Customer ID: ", "")
End If

If InStr(.CurrentLine, "Customer Name: ") > 0 Then
S.CustomerName = Replace(.CurrentLine, "Customer Name: ", "")
End If

If Not .LineContains("Customer ID:", "Customer Name:", "Product") Then
S.Product = .Trim(Mid(.CurrentLine, 1, 8))
S.Qty = .Trim(Mid(.CurrentLine, 9, 8))
S.Rate = .Trim(Mid(.CurrentLine, 17, 8))
S.Amt = .Trim(Mid(.CurrentLine, 25, 8))
Set Rng = Rng.Offset(1, 0)
With S
Rng.Value = Array(.CustomerID, .CustomerName, .Product, .Qty, .Rate, .Amt)
End With
End If
Loop
End With
End Sub



Thanks
mg

 

[Radoslaw Poprawski]

Task is Copy Currency, Period and Buy Type: if nothing is mentioned infront of it Consider (zero value)

Where do u have the 0 value exacly.
Can you elaborate a bit on this

 

[Mallesh23]

Hi RadoSlaw,

Actually some time there will not be any data , infront of Buy Type:

So I am giving default value as 0 or n/a or dash or not found and putting in excel.


if I get some hint I will modify the code as per my requirement. thanks in advance for looking into this.




Thanks
mg

 

[Radoslaw Poprawski]

is this expected result?

Book1
	A	B	C	D	E	F	G	H
1	Currency	Period	Buy Type		What u want to filter: ===>>>>	0
2	USD	ABC+PQR	Manual		USD	ABC+PQR	Manual
3	INR	ABC+PQR	0		AUD	--------	AAA,BBB CCC DDD HHH
4	AUD	--------	AAA,BBB CCC DDD HHH
5
6	Currency	Period	Buy Type		What u want to filter: ===>>>>	Not To Be Used
7	USD	ABC+PQR	Manual		USD	ABC+PQR	Manual
8	INR	ABC+PQR	Not To Be Used		AUD	--------	AAA,BBB CCC DDD HHH
9	AUD	--------	AAA,BBB CCC DDD HHH
Sheet1

Cell Formulas
Range	Formula
E2:G3	E2	=FILTER(Table1,Table1[Buy Type]<>$F$1)
E7:G8	E7	=FILTER(Table13,Table13[Buy Type]<>$F$6)
Dynamic array formulas.

if so its done by

=filter()

function

Also is ur office version accurate?
its best to switch to 365.

 

[Mallesh23]

Hi RadoSlow,

Thanks for your help and time, But here I am looking for help in vba.

using instr , mid or regular expression style. like this.




Thanks
mg

 

[Radoslaw Poprawski]

if you insist on VBA

or this might help you:

thats where I learned how to use adv filter in VBA.

sorry for not being able to help more

 

[Sufiyan97]

Just formula solution if anyone wants

Book1
	A	B	C	D
7	Currency : USD Period : ABC+PQR Buy Type: Manual	USD	ABC+PQR	Manual
8	Currency : INR Period : ABC+PQR Buy Type:	INR	ABC+PQR
9	Currency : AUD Period : -------- Buy Type: AAA,BBB CCC DDD HHH	AUD	--------	AAA,BBB CCC DDD HHH
Sheet1

Cell Formulas
Range	Formula
B7:B9	B7	=TRIM(LEFT(SUBSTITUTE(MID(A7,FIND("Currency",A7)+11,99)," ",REPT(" ",99)),99))
C7:C9	C7	=TRIM(LEFT(SUBSTITUTE(MID(A7,FIND(":",SUBSTITUTE(A7,":","x",1))+2,99),"Buy",REPT(" ",99)),99))
D7:D9	D7	=MID(A7,FIND("Type",A7)+6,99)

 

[DanteAmor]

Try this. results in A to C
"c:\trabajo\data.txt" 'update path an file name

Sub ExtractValuesFromText()
  Dim LineofText As Variant, xFile As Variant
  Dim a As Variant, sItems As Variant, s As Variant
  Dim i As Long
  
  ' Open the file for Input.
  xFile = "c:\trabajo\data.txt"   'update path an file name
  Open xFile For Input As #1
  
  Range("A:C").ClearContents
  Range("A1:C1").Value = Array("Currency", "Period", "Buy Type")
  i = 2
  ' Read each line of the text file into a single string
  Do While Not EOF(1)
    Line Input #1, LineofText
    If LineofText <> "" Then
      sItems = Split(LineofText, ":")
      Range("A" & i).Value = WorksheetFunction.Trim(Replace(Replace(sItems(1), "Currency", ""), "Period", ""))
      Range("B" & i).Value = WorksheetFunction.Trim(Replace(sItems(2), "Buy Type", ""))
      If WorksheetFunction.Trim(sItems(3)) = "" Then s = 0 Else s = WorksheetFunction.Trim(sItems(3))
      Range("C" & i).Value = s
      i = i + 1
    End If
  Loop
  ' Close the file.
  Close #1
End Sub