Finding a specific text

  • Thread starter Thread starter Don Doan
  • Start date Start date
D

Don Doan

Hi there,
I'm new to macro and I need some help with the program.

Basically, from cell B2 to B25...i want to look for the three character NHA
(in that order). If it's not there, erase the whole row. If it's there, keep
the row. There may be some characters or spaces before and after that word
NHA.
I a few lines in the program. If someone can help me modify it, that would
be great.

Sub Macro1()

Dim k As Long

For k = Cells(25, "b").End(xlUp).Row To 2 Step -1
If Cells(k, "b") <> "*NHA*" Then
Rows(k).EntireRow.Delete
End If
Next k

End Sub
 
This is a little different from what you describe, but probably a reasonable
alternative:

Sub copyit()
response = InputBox("Search for what")
Dim MyRange, MyRange1 As Range
Sheets("Sheet1").Select
lastrow = Sheets("Sheet1").Range("A65536").End(xlUp).Row
Set MyRange = Sheets("Sheet1").Range("A1:A" & lastrow)
For Each c In MyRange
If UCase(CStr(c.Value)) = UCase(response) Then
If MyRange1 Is Nothing Then
Set MyRange1 = c.EntireRow
Else
Set MyRange1 = Union(MyRange1, c.EntireRow)
End If
End If
Next
MyRange1.Select
Selection.Copy
Sheets("Sheet2").Select
Range("A1").Select
ActiveSheet.Paste
End Sub

HTH,
Ryan---
 
Or this............
Sub CopyNHA()

Dim DestSheet As Worksheet
Set DestSheet = Worksheets("Sheet2")

Dim sRow As Long
Dim dRow As Long
Dim sCount As Long
sCount = 0
dRow = 0

myword = InputBox("Enter items to search for.")

For sRow = 1 To Range("A65536").End(xlUp).Row

If Cells(sRow, "A") Like "*" & myword & "*" Then
sCount = sCount + 1
dRow = dRow + 1
Cells(sRow, "A").Copy Destination:=DestSheet.Cells(dRow, "A")
End If
Next sRow

MsgBox sCount & " Significant rows copied", vbInformation, "Transfer Done"

End Sub

HTH,
Ryan--
 
Hi here,
Thanks for the quick answer.Your program is quite complicated...is it
possible just to correct mine?
 
...is it possible just to correct mine?

Like this maybe...

Sub DeleteNonNHArows()
Dim K As Long
For K = 25 To 2 Step -1
If Not Cells(K, "B").Value Like "*NHA*" Then
Rows(K).EntireRow.Delete
End If
Next
End Sub
 
You can use something like this:

Sub Find_Cells()

On Error GoTo Error_Handler

Range("B2").Select
Do Until ActiveCell = ""
ActiveCell.Find(What:="NHA", MatchCase:=xlYes).Activate
Next_Case:
ActiveCell(2, 1).Select
Loop

Error_Handler:

If Err.Number = 91 Then
Activecell.EntireRow.Delete
Activecell(0,1).Select 'Because deleting the row will shift up the next row
Resume Next_Case
End If

End Sub
 
Back
Top