How to search a specific text constellation?

[Cinema]

Hi,

I want to search a specific text constellation, then I will do some operations that are not necessary at the moment.
The text that I want to search should begin with ARS and should have a specific word (f.ex. House) in it.
Here: ARS blabla House blabla

My idea is: First find the cells that begin with ARS and then find the cell with the specific word. But I don't know how to write this.
Here is my code so far.

Option Explicit
Public Const SHEET1 As String = "Sheet1"
Sub Search()
 Dim fname As String 
 Dim fpath As String 
 Dim data As Workbook    'CSV Data
 Dim tool  As Workbook    'This Workbook
Dim number As Integer
Set tool = ThisWorkbook
fpath = tool.Sheets(TABELLE1).Range("Path").Value
 fname = tool.Sheets(TABELLE1).Range("Input").Value
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
On Error Resume Next
 Set daten = Workbooks(fname)
 On Error GoTo 0
 If daten Is Nothing Then
 Set daten = Workbooks.Open(fpath & "" & fname, ReadOnly:=True) 
 WbOpen = False 
 Else
 WbOpen = True 
number = Workbooks(fname).Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
 For i = 1 To number
 If (Left(daten.Sheets(1).Cells(1, i).Value, 3) = "ARS") Then 'if the first 3 letters begin with "ARS" then..
End Sub

[snb]

Please, use code tags !

What kind of file are you looking in ? csv, TXT, html, xlsx ?

[Cinema]

Hi snb,

I am looking in CSV file. Sorry for not using code tags.

[Cinema]

Option Explicit

 Public Const SHEET1 As String = "Sheet1"

 Sub Search()
 Dim fname As String 
 Dim fpath As String 
 Dim data As Workbook    '<------    CSV Data I am looking in
 Dim tool  As Workbook    'This Workbook

 Dim number As Integer

 Set tool = ThisWorkbook

 fpath = tool.Sheets(SHEET1).Range("Path").Value
 fname = tool.Sheets(SHEET1).Range("Input").Value
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual


 On Error Resume Next
 Set daten = Workbooks(fname)
 On Error GoTo 0
 If daten Is Nothing Then
 Set daten = Workbooks.Open(fpath & "" & fname, ReadOnly:=True) 
 WbOpen = False 
 Else
 WbOpen = True 

 number = Workbooks(fname).Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
 For i = 1 To number
 If (Left(daten.Sheets(1).Cells(1, i).Value, 3) = "ARS") Then 'if the first 3 letters begin with "ARS" then..

 .......


 End Sub

[snb]

You can use this

Sub M_snb()
   sn=filter(filter(split(createobejct("scripting.filesystemobject").opentextfile("G:\OF\voorbeeld.csv").readall,vbcrlf),"ARS"),"house")

   for j=0 to ubound(sn)
     msgbox sn(j)
   next
End Sub

[GTO]

Lightly tested, but I think that this would work. With the ParamArray, you could search for one or more words being required.

Option Explicit
  
Public Function ContainsDesiredPattern(ByVal Cell As Range, KillLeadingOrFollowingSpaces As Boolean, ParamArray Words2LookFor() As Variant) As Boolean
'             Late-bound|Early-bound
Static REX As Object    ' VBScript_RegExp_55.RegExp
Dim strCellText As String
Dim Index As Long
  
  ' We used Static, so we only have to create the object once.  Test to see if already created...
  If REX Is Nothing Then
    Set REX = CreateObject("VBScript.RegExp")
    With REX
      .Global = False
      .IgnoreCase = True
    End With
  End If
  
  If KillLeadingOrFollowingSpaces Then
    strCellText = Trim$(Cell.Value)
  Else
    strCellText = Cell.Value
  End If
  
  ' Test for 'ARS', if fails, we'll skip further checks
  ContainsDesiredPattern = (Left$(strCellText, 3) = "ARS")
  
  If ContainsDesiredPattern Then
    'Loop thru the word or words we are requiring
    For Index = 0 To UBound(Words2LookFor)
      'Simple pattern that looks for existence of the word surrounded by word boundaries
      REX.Pattern = "\b" & Words2LookFor(Index) & "\b"
      'If we fail our test, the word wasn't found, so flip our flag and exit
      If Not REX.Test(strCellText) Then
        ContainsDesiredPattern = False
        Exit Function
      End If
    Next
  End If
  
End Function
  
Sub example()
Dim sCellValue As String
  
  Sheet1.Cells(1).Value = "ARS big house on the hill"
  
  MsgBox "Found value(s) = " & ContainsDesiredPattern(Sheet1.Cells(1), True, "House")
  MsgBox "Found value(s) = " & ContainsDesiredPattern(Sheet1.Cells(1), True, "House", "HILL")
  MsgBox "Found value(s) = " & ContainsDesiredPattern(Sheet1.Cells(1), True, "House", "HILL", "little")
  
  Sheet1.Cells(1).Value = "Big house on the hill"
  MsgBox "Found value(s) = " & ContainsDesiredPattern(Sheet1.Cells(1), True, "House", "HILL")
  
End Sub

Hope that helps,

Mark

[Cinema]

Hi snb,

thank you very much for your help. I don't how to add this in my code. It gives me the error "Sub or Function not defined".

[snb]

It's a replacement of all your code.

Typo:

Sub M_snb() 
    sn=filter(filter(split(createobject("scripting.filesystemobject").opentextfile("G:\OF\voorbeeld.csv").readall,vbcrlf),"ARS"),"house") 
     
    For j=0 To ubound(sn) 
        msgbox sn(j) 
    Next 
End Sub

You will have to adapt the file name "G:\OF\voorbeeld.csv"

[Cinema]

Hi snb,

ok thank you. I'll try this

[Cinema]

Hi GTO,

thank so much for your help. This code is a little complex for me. Where is the path in the code? I don't know how to Combine it with my code

[Cinema]

Hi snb,

what can I do, if I want instead of the msgbox some copy paste operations. The code should find the cell with "ARS....specific word..." value and then copy the 2nd smallest number in the column. The numbers are listes below the Header "ARS...specific word...". After copying it should paste the number into the other workbook and go on searching.

[snb]

A csv file has no 'cells', nor 'columns'.

[mikerickson]

I think that the built in Find with the string "ARS*House*" would what you want.

[Cinema]

ok thank you mikerickson