Need help VBA on excel spredsheet

[Lillian]

I have one excel spredsheet with 5 different
worksheet "Monday", "Tuesday","Wednesday", "Thursday", "Fr
iday", each worksheet has about 2,500 records, I need to
find out on each records from ColumnA to Columns EA that
contain "spec. xxxx" then need to moved to columns G, and
leave the space there, example find "spec. xxxx" in
columnI then will be moved to columnG, then deleted
columnsI, leave space there.

Except one condition if find "spec. xxxx" within any long
paragraph will be ignored, example some of record like
this one, record #562 of Monday worksheet,on column H
has "Motion Awarding Bid, Spec. 2472 (Reclaimed Water
Pipeline) to Kershaw Construction Company, Inc." has
Sepc. 2472, just ignired, do not need to moved "Spec.
2472" to column G, on same record #562 on column N
has "spec. 2479", so only need to moved this column N to
columnG, and leave the space in column N.

Need help on this VBA, thank you so much

LIllian

 

[Dick Kusleika]

Lillian

Try this code on a COPY of your data (just in case something goes wrong).
Let me know if needs modification or if you have questions about it.

Sub MoveSpec()

Dim FndRng As Range
Dim SrchRng As Range
Dim sh As Worksheet
Dim FirstAdd As String
Dim SpecLoc As Long
Dim LastRow As Long

'Loop through worksheets
For Each sh In ThisWorkbook.Worksheets

'Find the lastrow used on the sheet
LastRow = sh.Cells.SpecialCells(xlCellTypeLastCell).Row

'Set the range to search excluding column G
Set SrchRng = Union(sh.Range("a1:f" & LastRow), _
sh.Range("h1:ea" & LastRow))

'Find the first occurrence of spec.
Set FndRng = SrchRng.Find("spec.", , , xlPart)

'if found
If Not FndRng Is Nothing Then

'Store the address of the first found cell
FirstAdd = FndRng.Address

Do
'Find where spec. is in the cell
SpecLoc = InStr(1, FndRng.Value, "spec.")

'test that it's spec. + 4 digits
If Mid(FndRng.Value, SpecLoc, 10) Like "spec. ####" Then

'Test that it's not part of a longer
'string
If Len(FndRng.Value) <= 10 Then

'Write to column G and delete found cell
sh.Cells(FndRng.Row, 7).Value = FndRng.Value
FndRng.ClearContents
End If
End If

'Find next occurrence of spec.
Set FndRng = SrchRng.Find("spec.", FndRng, , xlPart)

'Stop loop when first cell is found again
Loop Until FndRng.Address = FirstAdd
End If
Next sh

End Sub