VBA to find next value

1

1Ronin

New Member
Joined
Aug 21, 2017
Messages
40
Office Version
  1. 365
Platform
  1. Windows
Hello,

I have a bigger macro that open many TXT files one by one, search for different values and
copy after in a data sheet. At one point I need to find the value for "Code" which is a number.
If TXT file is opened by Excel, this value is in column A and the position of row can be different from file to file. But, is always after word "CODIGO".
An partial example of TXT file is below:

TIEMPO;01:53;
CODIGO;
23;MAX;

I have below code, which is used with some modifications in other parts of macro for different parameters, but obviously is not good for me. This code is giving always the result "CODIGO". I need to find next value (23).

Code: 
 If UBound(Split(ReadData, ";")) >= 1 Then  If InStr(1, Split(ReadData, ";")(0), "CODIGO") > 0 Then
    
   Code = Split(ReadData, ";")(0)
   
  End If
 End If

Please help me to find correct value. I know that is easy, but not for me:mad:
Thank you.
 
Sort by date Sort by votes
Re: Help VBA to find next value

Hi again,

The code from post #4 is repeating many time, with some small modification, but without the line added by you (Line Input #1 , ReadData).
The entire code is big. Can I attach it as zip file? Or, just post here?
 
Upvote 0

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
Re: Help VBA to find next value

Simply post the code
- I will look at it later today or maybe tomorrow
- instead of repeating perhaps a loop calling a function could be used to make the code much shorter

thanks
 
Upvote 0
Re: Help VBA to find next value

Agree with your second statement. Unfortunately I don't know how to do it :(
See actual code (all working except NumOP part:

Code: 
Const TestPlan = "28384347"

Sub Copyfromtext()
Dim Prod As Range, TestPlancc As String, s As Long, i As Long, TextFile() As String, ReadData As String, ValT As Variant, Code As Variant, NumOp As Variant, Pallet As Variant, X As Long, Y As Long, Val_All() As Variant
Dim StrFile As String, Fpath As String, Serie As String, DataB As Date, Ora As String, Hour As Variant, Bench As String




Dim OP101 As Variant
Dim OP901 As Variant
Dim OP1 As Variant
Dim OP102 As Variant
Dim OP902 As Variant
Dim OP2 As Variant
Dim OP202 As Variant
Dim OP3 As Variant
Dim OP5 As Variant
Dim OP4 As Variant
Dim OP6 As Variant
Dim OP19 As Variant
Dim OP14 As Variant
Dim OP107 As Variant
Dim OP115 As Variant
Dim OP915 As Variant
Dim OP15 As Variant
Dim OP215 As Variant
Dim OP116 As Variant
Dim OP916 As Variant
Dim OP16 As Variant
Dim OP216 As Variant
Dim OP117 As Variant
Dim OP917 As Variant
Dim OP17 As Variant
Dim OP118 As Variant
Dim OP918 As Variant
Dim OP18 As Variant
Dim OP700 As Variant
Dim OP701 As Variant
Dim OP610 As Variant
Dim OP611 As Variant
Dim OP415 As Variant
Dim OP416 As Variant
Dim OP417 As Variant
Dim OP418 As Variant
Dim OP860 As Variant
Dim OP861 As Variant
Dim cod As String






Fpath = "C:\Users\123456\Desktop\Short\"


StrFile = Dir(Fpath)
Do While Len(StrFile) > 0
FilePath = Fpath & StrFile
StrFile = Dir
 
ReadData = ""
Rowc = Sheet1.Range("B" & Rows.Count).End(xlUp).Row


Open FilePath For Input As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 




Serie = ""
i = 0
j = 0
X = 0
Do Until EOF(1)
 i = i + 1
 Line Input [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , ReadData
  
'''SN
 If i = 1 Then
  Serie = Split(ReadData, ";")(8)
 End If
 
'''Test plan
 If i = 3 Then
  TestPlancc = Split(ReadData, ";")(1)
  If Left(Trim(TestPlancc), Len(TestPlan)) = TestPlan Then X = 1
  End If
 
'''Data
 If i = 5 Then
  datacc = Split(ReadData, ";")(0)
  DataB = DateSerial(Val(Right(datacc, 4)), Val(Left(Right(datacc, 6), 2)), Val(Left(datacc, 2)))
 End If
 
'''Ora
 If i = 5 Then
  Ora = Split(ReadData, ";")(1)
  Hour = Ora / 86400
 End If
  
'''station
 If i = 1 Then
  Bench = Split(ReadData, ";")(1)
 End If
 
''pallet
 If i = 1 Then
  Pallet = Split(ReadData, ";")(5)
 End If
 
 
  
 ''date test.
 If X = 1 Then
   
 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 '''CT
  If UBound(Split(ReadData, ";")) >= 1 Then
   If InStr(1, Split(ReadData, ";")(0), "TIEMPO") > 0 Then
    ValT = Split(ReadData, ";")(1)
   End If
  End If


 '''Cod 
  If UBound(Split(ReadData, ";")) >= 1 Then
   If InStr(1, Split(ReadData, ";")(0), "CODIGO") > 0 Then
    Line Input [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , ReadData
    Code = Split(ReadData, ";")(0)
  End If
 End If


 '''Num OP
  If UBound(Split(ReadData, ";")) >= 1 Then
   If InStr(1, Split(ReadData, ";")(0), "NUM OP") > 0 Then
           'Line Input [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , ReadData
            NumOp = Split(ReadData, ";")(0)
  End If
 End If
 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  
  
 '''results. Col(19) = DATO!
 '''Fill
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000101") > 0 Then
    OP101 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000901") > 0 Then
    OP901 = CDbl(Split(ReadData, ";")(19))
    End If
   End If
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000001") > 0 Then
    OP1 = CDbl(Split(ReadData, ";")(19))
     End If
   End If
   
 '''Flu
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000102") > 0 Then
    OP102 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000902") > 0 Then
    OP902 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000002") > 0 Then
    OP2 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000202") > 0 Then
    OP202 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
   
  '''HH 
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000003") > 0 Then
    OP3 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000005") > 0 Then
    OP5 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
   
  ''high
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000004") > 0 Then
    OP4 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000006") > 0 Then
    OP6 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
   
  '''leak

  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000019") > 0 Then
    OP19 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
 If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000014") > 0 Then
    OP14 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
 If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000107") > 0 Then
    OP107 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
   
  '''Max 1
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000115") > 0 Then
    OP115 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000915") > 0 Then
    OP915 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000015") > 0 Then
    OP15 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000215") > 0 Then
    OP215 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
      
  '''Max 2
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000116") > 0 Then
    OP116 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000916") > 0 Then
    OP916 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000016") > 0 Then
    OP16 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000216") > 0 Then
    OP216 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
   
  '''Id
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000117") > 0 Then
    OP117 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000917") > 0 Then
    OP917 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000017") > 0 Then
    OP17 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
   
   '''Cra
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000118") > 0 Then
    OP118 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000918") > 0 Then
    OP918 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000018") > 0 Then
    OP18 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
   
  '''H2H
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000700") > 0 Then
    OP700 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000701") > 0 Then
    OP701 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
   
   '''low
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000610") > 0 Then
    OP610 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000611") > 0 Then
    OP611 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
   
  '''Back
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000415") > 0 Then
    OP415 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000416") > 0 Then
    OP416 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000417") > 0 Then
    OP417 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000418") > 0 Then
    OP418 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
   
  '''LPL
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000860") > 0 Then
    OP860 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
  If UBound(Split(ReadData, ";")) >= 18 Then
   If InStr(1, Split(ReadData, ";")(0), "000861") > 0 Then
    OP861 = CDbl(Split(ReadData, ";")(19))
   End If
  End If
   
   
 j = j + 1
 End If
Loop
Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 






'''Copy
s = s + X
If s > 0 Then
 ReDim Preserve Val_All(1 To 50, 1 To s)
 Val_All(1, s) = Serie
 Val_All(2, s) = DataB
 Val_All(3, s) = Hour
 Val_All(4, s) = Bench
 Val_All(5, s) = TestPlancc
 Val_All(6, s) = Code
 Val_All(7, s) = NumOp
 Val_All(8, s) = Pallet
 Val_All(9, s) = ValT
 Val_All(10, s) = OP101
 Val_All(11, s) = OP901
 Val_All(12, s) = OP1
 Val_All(13, s) = OP102
 Val_All(14, s) = OP902
 Val_All(15, s) = OP2
 Val_All(16, s) = OP202
 Val_All(17, s) = OP3
 Val_All(18, s) = OP5
 Val_All(19, s) = OP4
 Val_All(20, s) = OP6
 Val_All(21, s) = OP19
 Val_All(22, s) = OP14
 Val_All(23, s) = OP107
 Val_All(24, s) = OP115
 Val_All(25, s) = OP915
 Val_All(26, s) = OP15
 Val_All(27, s) = OP215
 Val_All(28, s) = OP116
 Val_All(29, s) = OP916
 Val_All(30, s) = OP16
 Val_All(31, s) = OP216
 Val_All(32, s) = OP117
 Val_All(33, s) = OP917
 Val_All(34, s) = OP17
 Val_All(35, s) = OP118
 Val_All(36, s) = OP918
 Val_All(37, s) = OP18
 Val_All(38, s) = OP700
 Val_All(39, s) = OP701
 Val_All(40, s) = OP610
 Val_All(41, s) = OP611
 Val_All(42, s) = OP415
 Val_All(43, s) = OP416
 Val_All(44, s) = OP417
 Val_All(45, s) = OP418
 Val_All(46, s) = OP860
 Val_All(47, s) = OP861
 
 


End If


Loop


If s > 0 Then
 Range("A" & Rowc + 1).Resize(s, 50).Value = Application.Transpose(Val_All)
 Range("B" & Rowc + 1).Resize(s, 1).NumberFormat = "dd/mm/yyyy"
 Range("C" & Rowc + 1).Resize(s, 1).NumberFormat = "hh:mm:ss"


End If
End Sub


Thank you for spending your time for me.
 
Upvote 0
Re: Help VBA to find next value

Been busy today. Will post tomorrow
 
Upvote 0
Re: Help VBA to find next value

Please test this code
- amendments mades without testing it in any way

1. Tests for CODIGO and NUM OP amended - this has (hopefully :confused:) corrected the End of File error
2. The rest of the code is your code "tidied up" to reduce IF tests and calculations
3. I think we can reduce the code more -but I want you to test this first

Let me know

Code: 
Const TestPlan = "28384347"

Sub Copyfromtext()
Dim Prod As Range, TestPlancc As String, s As Long, i As Long, TextFile() As String, ReadData As String, ValT As Variant, Code As Variant, NumOp As Variant, Pallet As Variant, X As Long, Y As Long, Val_All() As Variant
Dim StrFile As String, Fpath As String, Serie As String, DataB As Date, Ora As String, Hour As Variant, Bench As String

Dim OP101 As Variant
Dim OP901 As Variant
Dim OP1 As Variant
Dim OP102 As Variant
Dim OP902 As Variant
Dim OP2 As Variant
Dim OP202 As Variant
Dim OP3 As Variant
Dim OP5 As Variant
Dim OP4 As Variant
Dim OP6 As Variant
Dim OP19 As Variant
Dim OP14 As Variant
Dim OP107 As Variant
Dim OP115 As Variant
Dim OP915 As Variant
Dim OP15 As Variant
Dim OP215 As Variant
Dim OP116 As Variant
Dim OP916 As Variant
Dim OP16 As Variant
Dim OP216 As Variant
Dim OP117 As Variant
Dim OP917 As Variant
Dim OP17 As Variant
Dim OP118 As Variant
Dim OP918 As Variant
Dim OP18 As Variant
Dim OP700 As Variant
Dim OP701 As Variant
Dim OP610 As Variant
Dim OP611 As Variant
Dim OP415 As Variant
Dim OP416 As Variant
Dim OP417 As Variant
Dim OP418 As Variant
Dim OP860 As Variant
Dim OP861 As Variant
Dim cod As String

Dim ReadData19 As Variant, ReadData0 As String, Previous As String

Fpath = "C:\Users\123456\Desktop\Short\"

StrFile = Dir(Fpath)
[COLOR=#0000cd]Do While Len(StrFile) > 0[/COLOR]

FilePath = Fpath & StrFile
StrFile = Dir
 
ReadData = ""
Rowc = Sheet1.Range("B" & Rows.Count).End(xlUp).Row


Open FilePath For Input As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 


Serie = ""
i = 0
j = 0
X = 0
Do Until EOF(1)
    i = i + 1
    Line Input [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , ReadData            
  
'''SN
    If i = 1 Then
        Serie = Split(ReadData, ";")(8)
    End If
 
'''Test plan
    If i = 3 Then
        TestPlancc = Split(ReadData, ";")(1)
        If Left(Trim(TestPlancc), Len(TestPlan)) = TestPlan Then X = 1
    End If
 
'''Data
    If i = 5 Then
        datacc = Split(ReadData, ";")(0)
        DataB = DateSerial(Val(Right(datacc, 4)), Val(Left(Right(datacc, 6), 2)), Val(Left(datacc, 2)))
    End If
 
'''Ora
    If i = 5 Then
        Ora = Split(ReadData, ";")(1)
        Hour = Ora / 86400
    End If
  
'''station
    If i = 1 Then
        Bench = Split(ReadData, ";")(1)
    End If
 
''pallet
    If i = 1 Then
        Pallet = Split(ReadData, ";")(5)
    End If
 
  
 ''date test.
 If X = 1 Then
   
 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

[COLOR=#ff0000]    If UBound(Split(ReadData, ";")) >= 1 Then[/COLOR]
    
 '''CT
        ReadData           
        If InStr(1, Split(ReadData, ";")(0), "TIEMPO") > 0 Then ValT = Split(ReadData, ";")(1)
    
 '''Cod
[COLOR=#0000cd]        If Previous = "CODIGO" Then
            Code = Split(ReadData, ";")(0)
            Previous = ""
        End If
        If InStr(1, Split(ReadData, ";")(0), "CODIGO") > 0 Then Previous = "CODIGO"[/COLOR]
  
 '''Num OP
[COLOR=#0000cd]        If Previous = "NUM OP" Then
            NumOp = Split(ReadData, ";")(0)
            Previous = ""
        End If
        If InStr(1, Split(ReadData, ";")(0), "NUM OP") > 0 Then Previous = "NUM OP"[/COLOR]
    
    [COLOR=#ff0000]End If   [/COLOR]   ' UBound(Split(ReadData, ";")) >= 1
 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  
 '''results. Col(19) = DATO!
 '''Fill
  
    [COLOR=#ff0000]If UBound(Split(ReadData, ";")) >= 18 Then[/COLOR]
        ReadData0 = Split(ReadData, ";")(0)
        ReadData19 = CDbl(Split(ReadData, ";")(19))
   
        If InStr(1, ReadData0, "000101") > 0 Then OP101 = ReadData19
        If InStr(1, ReadData0, "000901") > 0 Then OP901 = ReadData19
        If InStr(1, ReadData0, "000001") > 0 Then OP1 = ReadData19
   
 '''Flu
        If InStr(1, ReadData0, "000102") > 0 Then OP102 = ReadData19
        If InStr(1, ReadData0, "000902") > 0 Then OP902 = ReadData19
        If InStr(1, ReadData0, "000002") > 0 Then OP2 = ReadData19
        If InStr(1, ReadData0, "000202") > 0 Then OP202 = ReadData19
   
  '''HH
        If InStr(1, ReadData0, "000003") > 0 Then OP3 = ReadData19
        If InStr(1, ReadData0, "000005") > 0 Then OP5 = ReadData19
    
  ''high
        If InStr(1, ReadData0, "000004") > 0 Then OP4 = ReadData19
        If InStr(1, ReadData0, "000006") > 0 Then OP6 = ReadData19
   
  '''leak
        If InStr(1, ReadData0, "000019") > 0 Then OP19 = ReadData19
        If InStr(1, ReadData0, "000014") > 0 Then OP14 = ReadData19
        If InStr(1, ReadData0, "000107") > 0 Then OP107 = ReadData19
   
  '''Max 1
        If InStr(1, ReadData0, "000115") > 0 Then OP115 = ReadData19
        If InStr(1, ReadData0, "000915") > 0 Then OP915 = ReadData19
        If InStr(1, ReadData0, "000015") > 0 Then OP15 = ReadData19
        If InStr(1, ReadData0, "000215") > 0 Then OP215 = ReadData19
      
  '''Max 2
        If InStr(1, ReadData0, "000116") > 0 Then OP116 = ReadData19
        If InStr(1, ReadData0, "000916") > 0 Then OP916 = ReadData19
        If InStr(1, ReadData0, "000016") > 0 Then OP16 = ReadData19
        If InStr(1, ReadData0, "000216") > 0 Then OP216 = ReadData19
   
  '''Id
        If InStr(1, ReadData0, "000117") > 0 Then OP117 = ReadData19
        If InStr(1, ReadData0, "000917") > 0 Then OP917 = ReadData19
        If InStr(1, ReadData0, "000017") > 0 Then OP17 = ReadData19
   
   '''Cra
        If InStr(1, ReadData0, "000118") > 0 Then OP118 = ReadData19
        If InStr(1, ReadData0, "000918") > 0 Then OP918 = ReadData19
        If InStr(1, ReadData0, "000018") > 0 Then OP18 = ReadData19
   
  '''H2H
        If InStr(1, ReadData0, "000700") > 0 Then OP700 = ReadData19
        If InStr(1, ReadData0, "000701") > 0 Then OP701 = ReadData19

   '''low
        If InStr(1, ReadData0, "000610") > 0 Then OP610 = ReadData19
        If InStr(1, ReadData0, "000611") > 0 Then OP611 = ReadData19
   
  '''Back
        If InStr(1, ReadData0, "000415") > 0 Then OP415 = ReadData19
        If InStr(1, ReadData0, "000416") > 0 Then OP416 = ReadData19
        If InStr(1, ReadData0, "000417") > 0 Then OP417 = ReadData19
        If InStr(1, ReadData0, "000418") > 0 Then OP418 = ReadData19
   
  '''LPL
        If InStr(1, ReadData0, "000860") > 0 Then OP860 = ReadData19
        If InStr(1, ReadData0, "000861") > 0 Then OP861 = ReadData19
   
   [COLOR=#ff0000]End If [/COLOR]       ' UBound(Split(ReadData, ";")) >= 18
   
 j = j + 1
 End If     '  X =1
Loop        '  until EOF(1)
Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 

'''Copy
    s = s + X
    If s > 0 Then
        ReDim Preserve Val_All(1 To 50, 1 To s)
        Val_All(1, s) = Serie
        Val_All(2, s) = DataB
        Val_All(3, s) = Hour
        Val_All(4, s) = Bench
        Val_All(5, s) = TestPlancc
        Val_All(6, s) = Code
        Val_All(7, s) = NumOp
        Val_All(8, s) = Pallet
        Val_All(9, s) = ValT
        Val_All(10, s) = OP101
        Val_All(11, s) = OP901
        Val_All(12, s) = OP1
        Val_All(13, s) = OP102
        Val_All(14, s) = OP902
        Val_All(15, s) = OP2
        Val_All(16, s) = OP202
        Val_All(17, s) = OP3
        Val_All(18, s) = OP5
        Val_All(19, s) = OP4
        Val_All(20, s) = OP6
        Val_All(21, s) = OP19
        Val_All(22, s) = OP14
        Val_All(23, s) = OP107
        Val_All(24, s) = OP115
        Val_All(25, s) = OP915
        Val_All(26, s) = OP15
        Val_All(27, s) = OP215
        Val_All(28, s) = OP116
        Val_All(29, s) = OP916
        Val_All(30, s) = OP16
        Val_All(31, s) = OP216
        Val_All(32, s) = OP117
        Val_All(33, s) = OP917
        Val_All(34, s) = OP17
        Val_All(35, s) = OP118
        Val_All(36, s) = OP918
        Val_All(37, s) = OP18
        Val_All(38, s) = OP700
        Val_All(39, s) = OP701
        Val_All(40, s) = OP610
        Val_All(41, s) = OP611
        Val_All(42, s) = OP415
        Val_All(43, s) = OP416
        Val_All(44, s) = OP417
        Val_All(45, s) = OP418
        Val_All(46, s) = OP860
        Val_All(47, s) = OP861
        
    End If      '  s > 0

Loop            '  While Len(StrFile) > 0

    If s > 0 Then
        Range("A" & Rowc + 1).Resize(s, 50).Value = Application.Transpose(Val_All)
        Range("B" & Rowc + 1).Resize(s, 1).NumberFormat = "dd/mm/yyyy"
        Range("C" & Rowc + 1).Resize(s, 1).NumberFormat = "hh:mm:ss"
    End If
End Sub
 
Upvote 0
Re: Help VBA to find next value

OOPS :oops::oops:

Ignore above post
- I spotted a mistake
- I will post again in a few minutes
 
Last edited:
Upvote 0
Test this instead
Code: 
Const TestPlan = "28384347"

Sub Copyfromtext()
Dim Prod As Range, TestPlancc As String, s As Long, i As Long, TextFile() As String, ReadData As String, ValT As Variant, Code As Variant, NumOp As Variant, Pallet As Variant, X As Long, Y As Long, Val_All() As Variant
Dim StrFile As String, Fpath As String, Serie As String, DataB As Date, Ora As String, Hour As Variant, Bench As String

Dim OP101 As Variant
Dim OP901 As Variant
Dim OP1 As Variant
Dim OP102 As Variant
Dim OP902 As Variant
Dim OP2 As Variant
Dim OP202 As Variant
Dim OP3 As Variant
Dim OP5 As Variant
Dim OP4 As Variant
Dim OP6 As Variant
Dim OP19 As Variant
Dim OP14 As Variant
Dim OP107 As Variant
Dim OP115 As Variant
Dim OP915 As Variant
Dim OP15 As Variant
Dim OP215 As Variant
Dim OP116 As Variant
Dim OP916 As Variant
Dim OP16 As Variant
Dim OP216 As Variant
Dim OP117 As Variant
Dim OP917 As Variant
Dim OP17 As Variant
Dim OP118 As Variant
Dim OP918 As Variant
Dim OP18 As Variant
Dim OP700 As Variant
Dim OP701 As Variant
Dim OP610 As Variant
Dim OP611 As Variant
Dim OP415 As Variant
Dim OP416 As Variant
Dim OP417 As Variant
Dim OP418 As Variant
Dim OP860 As Variant
Dim OP861 As Variant
Dim cod As String

Dim ReadData19 As Variant, ReadData0 As String, Previous As String

Fpath = "C:\Users\123456\Desktop\Short\"

StrFile = Dir(Fpath)
Do While Len(StrFile) > 0
FilePath = Fpath & StrFile
StrFile = Dir
 
ReadData = ""
Rowc = Sheet1.Range("B" & Rows.Count).End(xlUp).Row


Open FilePath For Input As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 


Serie = ""
i = 0
j = 0
X = 0
Do Until EOF(1)
    i = i + 1
    Line Input [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , ReadData          
    
[COLOR=#0000cd]    If Previous = "NUM OP" Then
        NumOp = Split(ReadData, ";")(0)
        Previous = ""
    End If
    If Previous = "CODIGO" Then
        Code = Split(ReadData, ";")(0)
        Previous = ""
    End If[/COLOR]
  
'''SN
    If i = 1 Then
        Serie = Split(ReadData, ";")(8)
    End If
 
'''Test plan
    If i = 3 Then
        TestPlancc = Split(ReadData, ";")(1)
        If Left(Trim(TestPlancc), Len(TestPlan)) = TestPlan Then X = 1
    End If
 
'''Data
    If i = 5 Then
        datacc = Split(ReadData, ";")(0)
        DataB = DateSerial(Val(Right(datacc, 4)), Val(Left(Right(datacc, 6), 2)), Val(Left(datacc, 2)))
    End If
 
'''Ora
    If i = 5 Then
        Ora = Split(ReadData, ";")(1)
        Hour = Ora / 86400
    End If
  
'''station
    If i = 1 Then
        Bench = Split(ReadData, ";")(1)
    End If
 
''pallet
    If i = 1 Then
        Pallet = Split(ReadData, ";")(5)
    End If
 
  
 ''date test.
 If X = 1 Then
   
 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    [COLOR=#ff0000]If UBound(Split(ReadData, ";")) >= 1 Then[/COLOR]
    
 '''CT
        If InStr(1, Split(ReadData, ";")(0), "TIEMPO") > 0 Then ValT = Split(ReadData, ";")(1)
    
 '''Cod
        If InStr(1, Split(ReadData, ";")(0), "CODIGO") > 0 Then Previous = "CODIGO"
 
 '''Num OP
        If InStr(1, Split(ReadData, ";")(0), "NUM OP") > 0 Then Previous = "NUM OP"
    
    [COLOR=#ff0000]End If [/COLOR]     ' UBound(Split(ReadData, ";")) >= 1
 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  
 '''results. Col(19) = DATO!
 '''Fill
  
    [COLOR=#ff0000]If UBound(Split(ReadData, ";")) >= 18 Then[/COLOR]
        ReadData0 = Split(ReadData, ";")(0)
        ReadData19 = CDbl(Split(ReadData, ";")(19))
   
        If InStr(1, ReadData0, "000101") > 0 Then OP101 = ReadData19
        If InStr(1, ReadData0, "000901") > 0 Then OP901 = ReadData19
        If InStr(1, ReadData0, "000001") > 0 Then OP1 = ReadData19
   
 '''Flu
        If InStr(1, ReadData0, "000102") > 0 Then OP102 = ReadData19
        If InStr(1, ReadData0, "000902") > 0 Then OP902 = ReadData19
        If InStr(1, ReadData0, "000002") > 0 Then OP2 = ReadData19
        If InStr(1, ReadData0, "000202") > 0 Then OP202 = ReadData19
   
  '''HH
        If InStr(1, ReadData0, "000003") > 0 Then OP3 = ReadData19
        If InStr(1, ReadData0, "000005") > 0 Then OP5 = ReadData19
    
  ''high
        If InStr(1, ReadData0, "000004") > 0 Then OP4 = ReadData19
        If InStr(1, ReadData0, "000006") > 0 Then OP6 = ReadData19
   
  '''leak
        If InStr(1, ReadData0, "000019") > 0 Then OP19 = ReadData19
        If InStr(1, ReadData0, "000014") > 0 Then OP14 = ReadData19
        If InStr(1, ReadData0, "000107") > 0 Then OP107 = ReadData19
   
  '''Max 1
        If InStr(1, ReadData0, "000115") > 0 Then OP115 = ReadData19
        If InStr(1, ReadData0, "000915") > 0 Then OP915 = ReadData19
        If InStr(1, ReadData0, "000015") > 0 Then OP15 = ReadData19
        If InStr(1, ReadData0, "000215") > 0 Then OP215 = ReadData19
      
  '''Max 2
        If InStr(1, ReadData0, "000116") > 0 Then OP116 = ReadData19
        If InStr(1, ReadData0, "000916") > 0 Then OP916 = ReadData19
        If InStr(1, ReadData0, "000016") > 0 Then OP16 = ReadData19
        If InStr(1, ReadData0, "000216") > 0 Then OP216 = ReadData19
   
  '''Id
        If InStr(1, ReadData0, "000117") > 0 Then OP117 = ReadData19
        If InStr(1, ReadData0, "000917") > 0 Then OP917 = ReadData19
        If InStr(1, ReadData0, "000017") > 0 Then OP17 = ReadData19
   
   '''Cra
        If InStr(1, ReadData0, "000118") > 0 Then OP118 = ReadData19
        If InStr(1, ReadData0, "000918") > 0 Then OP918 = ReadData19
        If InStr(1, ReadData0, "000018") > 0 Then OP18 = ReadData19
   
  '''H2H
        If InStr(1, ReadData0, "000700") > 0 Then OP700 = ReadData19
        If InStr(1, ReadData0, "000701") > 0 Then OP701 = ReadData19

   '''low
        If InStr(1, ReadData0, "000610") > 0 Then OP610 = ReadData19
        If InStr(1, ReadData0, "000611") > 0 Then OP611 = ReadData19
   
  '''Back
        If InStr(1, ReadData0, "000415") > 0 Then OP415 = ReadData19
        If InStr(1, ReadData0, "000416") > 0 Then OP416 = ReadData19
        If InStr(1, ReadData0, "000417") > 0 Then OP417 = ReadData19
        If InStr(1, ReadData0, "000418") > 0 Then OP418 = ReadData19
   
  '''LPL
        If InStr(1, ReadData0, "000860") > 0 Then OP860 = ReadData19
        If InStr(1, ReadData0, "000861") > 0 Then OP861 = ReadData19
   
   [COLOR=#ff0000]End If[/COLOR]        ' UBound(Split(ReadData, ";")) >= 18
   
 j = j + 1
 End If     '  X =1
Loop        '  until EOF(1)
Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 

'''Copy
    s = s + X
    If s > 0 Then
        ReDim Preserve Val_All(1 To 50, 1 To s)
        Val_All(1, s) = Serie
        Val_All(2, s) = DataB
        Val_All(3, s) = Hour
        Val_All(4, s) = Bench
        Val_All(5, s) = TestPlancc
        Val_All(6, s) = Code
        Val_All(7, s) = NumOp
        Val_All(8, s) = Pallet
        Val_All(9, s) = ValT
        Val_All(10, s) = OP101
        Val_All(11, s) = OP901
        Val_All(12, s) = OP1
        Val_All(13, s) = OP102
        Val_All(14, s) = OP902
        Val_All(15, s) = OP2
        Val_All(16, s) = OP202
        Val_All(17, s) = OP3
        Val_All(18, s) = OP5
        Val_All(19, s) = OP4
        Val_All(20, s) = OP6
        Val_All(21, s) = OP19
        Val_All(22, s) = OP14
        Val_All(23, s) = OP107
        Val_All(24, s) = OP115
        Val_All(25, s) = OP915
        Val_All(26, s) = OP15
        Val_All(27, s) = OP215
        Val_All(28, s) = OP116
        Val_All(29, s) = OP916
        Val_All(30, s) = OP16
        Val_All(31, s) = OP216
        Val_All(32, s) = OP117
        Val_All(33, s) = OP917
        Val_All(34, s) = OP17
        Val_All(35, s) = OP118
        Val_All(36, s) = OP918
        Val_All(37, s) = OP18
        Val_All(38, s) = OP700
        Val_All(39, s) = OP701
        Val_All(40, s) = OP610
        Val_All(41, s) = OP611
        Val_All(42, s) = OP415
        Val_All(43, s) = OP416
        Val_All(44, s) = OP417
        Val_All(45, s) = OP418
        Val_All(46, s) = OP860
        Val_All(47, s) = OP861
        
    End If      '  s > 0

Loop            '  While Len(StrFile) > 0

    If s > 0 Then
        Range("A" & Rowc + 1).Resize(s, 50).Value = Application.Transpose(Val_All)
        Range("B" & Rowc + 1).Resize(s, 1).NumberFormat = "dd/mm/yyyy"
        Range("C" & Rowc + 1).Resize(s, 1).NumberFormat = "hh:mm:ss"
    End If
End Sub
 
Upvote 0
Is stop at line:

If UBound(Split(ReadData, ";")) >= 18 Then
ReadData0 = Split(ReadData, ";")(0)
ReadData19 = CDbl(Split(ReadData, ";")(19))

Is giving error:
Run-time error "13""
Type mismatch
 
Upvote 0
There are lines where VBA cannot evaluate CDbl(Split(ReadData, ";")(19))

Code: 
If UBound(Split(ReadData, ";")) [COLOR=#ff0000]>= 18 [/COLOR]Then
[COLOR=#ff0000]is not consistent with[/COLOR]
OP915 = CDbl(Split(ReadData, ";")([COLOR=#ff0000]19[/COLOR]))

Try
Code: 
If UBound(Split(ReadData, ";"))[COLOR=#ff0000] > 18[/COLOR] Then


(In original code, CDbl(Split(ReadData, ";")(19)) was only evaluated after a second test for each value which prevented the original code failing)
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question
VBA: open and copy data from multiple (txt. files) to excel
Replies
1
Views
153
NdNoviceHlp
NdNoviceHlp
J
  • Question
Find Max Value by Group VBA
Replies
3
Views
478
DanteAmor
DanteAmor
J
  • Question
Automatically import .txt files into separate sheets in Excel
Replies
1
Views
166
John_w
J
S
  • Question
Automate user selected files.
Replies
1
Views
166
Shakeable_Drip
S
S
  • Question
Replace different text/strings in multiple files in one folder
Replies
1
Views
232
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,214,646
Messages
6,120,717
Members
448,985
Latest member
chocbudda

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top