PDA

View Full Version : How to search a specific text constellation?



Cinema
09-06-2016, 02:49 AM
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
09-06-2016, 03:39 AM
Please, use code tags !

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

Cinema
09-06-2016, 06:46 AM
Hi snb,

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

Cinema
09-06-2016, 06:48 AM
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
09-06-2016, 07:26 AM
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
09-06-2016, 07:52 AM
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
09-09-2016, 01:04 AM
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
09-09-2016, 01:18 AM
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
09-09-2016, 01:27 AM
Hi snb,

ok thank you. I'll try this

Cinema
09-09-2016, 01:55 AM
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
09-09-2016, 02:03 AM
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
09-09-2016, 03:44 AM
A csv file has no 'cells', nor 'columns'.

mikerickson
09-09-2016, 06:19 PM
I think that the built in Find with the string "ARS*House*" would what you want.

Cinema
09-13-2016, 12:55 AM
ok thank you mikerickson