Find words and neighbors using wildcards

[Mary M]

Hi everyone,

I've got a thesis riding on this, so any help would be REALL
appreciated!

I've got some experimental data in an Excel file with two columns: On
with words and one with numbers.

What I want to do is to save all the words for which their number is
100, AND for which there exists word* (ie: the original word with an
arbitrary letters following it) with a number < 50.

So for instance, if I have

abc 65
abcd 32
pqr 105
xyz 101
xyza 45
xyzbc 35


I would like an output (anywhere) which shows

xyz 101
xyza 45
xyzbc 35

Thank you so much for your help!
~Mary M

 

[Guest]

are the word and number in separate cells or is a space and the number
concatenated onto the end of the word, all in one column. Is the column
column A or and all other columns are blank?

will base words always be 3 characters?

 

[Mary M]

are the word and number in separate cells or is a space and the number
concatenated onto the end of the word, all in one column. Is th
column
column A or and all other columns are blank?

will base words always be 3 characters?

Dear Tom,

The words and numbers are in separate cells -- sorry, I didn't mak
this clear.

The base words can be any length.

Since the list is several thousand words long, and is alphabetical, i
would speed things up if I said "search for '-word*-' only within th
next ten rows", or something, instead of searching all thousand word
for each word on the list. However, if this is difficult, I've got al
day to let the program run...

Thanks for any help

 

[Guest]

this is vary lightly tested, but it worked for your sample data.

It looks at the first sheet in the tab order for the list of words and
numbers and writes results to the second sheet in the tab order

Sub Getwords()
Dim cell As Range, rng As Range
Dim rng1 As Range, num As Long
Dim num1 As Long, rw As Long
With Worksheets(1)
Set rng = .Range(.Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))

rw = 0
For Each cell In rng
If cell.Row < rng(rng.Count).Row And cell.Row > rw Then
If InStr(1, cell(2), cell, vbTextCompare) = 1 Then
num = Application.CountIf(.Range(cell, rng(rng.Count)), cell & "*")
Set rng1 = cell.Offset(1, 0).Resize(num - 1, 1)
num1 = Application.CountIf(rng1.Offset(0, 1), "<50")
If num1 > 0 And cell.Offset(0, 1) > 100 Then
cell.Resize(num, 2).Copy Destination:= _
Worksheets(2).Cells(Rows.Count, 1).End(xlUp)(2)
End If
End If
rw = rw + num - 1
Else
rw = rw + 1
End If
Next
End With

End Sub

 

[Mary M]

Hi Tom,

I was just coming to post that I think I got the answer, and then
find you solved it!

Well, here's my version:


Code
-------------------

Sub Find_Words()
' Select cell A2, *first line of data*.
Range("A2").Select
' Set Do loop to stop when an empty cell is reached.
Do Until IsEmpty(ActiveCell)

Dim root As String
root = ActiveCell.Value

If ActiveCell.Offset(0, 1).Value > 100 Then
Dim i As Integer
For i = 1 To 10
Dim deriv As String
deriv = ActiveCell.Offset(i, 0).Value
If InStr(deriv, root) = 1 Then
If ActiveCell.Offset(i, 1).Value < 50 Then
ActiveCell.Offset(0, 2).Value = root
ActiveCell.Offset(i, 2).Value = deriv
End If
End If
Next
End If


ActiveCell.Offset(1, 0).Select
Loop


End Sub


-------------------


I'll take a look at yours and see if you're doing something clevere
than me.

Thanks

 

[Guest]

I doubt I can be cleverer than you since you know what you want and I only
have what you described. There were some unanswered questions in my mind.

If the data looked like:
abc 65
abcd 32
abcdd 101
abcdde 101
abcddf 49
pqr 105
xyz 101
xyza 45
xyzbc 35

my revised macro would select


abcdd 101
abcdde 101
abcddf 49
xyz 101
xyza 45
xyzbc 35

but yours only selects the last 3

anyway, here is the revised. ( I believe it now works as intended by me)

Sub Getwords()
Dim cell As Range, rng As Range
Dim rng1 As Range, num As Long
Dim num1 As Long, rw As Long
With Worksheets(1)
Set rng = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))

For Each cell In rng
If Application.CountIf(Worksheets(2).Columns(1), cell) = 0 Then
If InStr(1, cell(2), cell, vbTextCompare) = 1 Then
num = Application.CountIf(.Range(cell, rng(rng.Count)), cell & "*")
Set rng1 = cell.Offset(1, 0).Resize(num - 1, 1)
num1 = Application.CountIf(rng1.Offset(0, 1), "<50")
Debug.Print cell.Address, num, rng1.Address, num1
If num1 > 0 And cell.Offset(0, 1) > 100 Then
cell.Resize(num, 2).Copy Destination:= _
Worksheets(2).Cells(Rows.Count, 1).End(xlUp)(2)
End If
End If
End If
Next
End With

End Sub

 

[Guest]

correction, you macro produces:

abcdd 101 abcdd
abcddf 49 abcddf
xyz 101 xyz
xyza 45 xyza
xyzbc 35 xyzbc

 

[Mary M]

I doubt I can be cleverer than you since you know what you want and
only have what you described. There were some unanswered questions i
my mind.

I guess that's because I'm not so good at explaining. Thanks so muc
for your help, though - I really apreciated it.

If the data looked like:
abc 65
abcd 32
abcdd 101
abcdde 101
abcddf 49
pqr 105
xyz 101
xyza 45
xyzbc 35

my revised macro would select


abcdd 101
abcdde 101
abcddf 49
xyz 101
xyza 45
xyzbc 35

but yours only selects the last 3

Actually, mine would select the first, third, and last three, which i
what I wanted. I wouldn't want to select abcdde, since this is
derivation, and is not < 50.

Thanks for your help