tricky find and replace
 

Ok I have 400 workbooks where I need to copy information into another cell.
I need it it to search worksheet "Data Entry" for "G. Cut Length" When it
finds that I need it to move down 16 rows. The data in that row needs to be
saved for the find. then I need to move down another 16 rows, the data in
that cell will be what needs to replace the find data. I wand it to search
for the find data on entire workbook and replace it with the other cell. "G.
Cut length is always in column C but the row changes, but the data to find is
alway 16 cells lower, and the to replace the find is always another 16.
Thanks for any help.

tricky find and replace
 

Sorry for the multiple post I kept recieving an error message saying it
wasn't recieved and to try again.

tricky find and replace
 

I'm not quite sure I understand what you want but try this

Sub findwhattofind()
Cells.Find("ab").Offset(32) = Cells.Find("ab").Offset(16)
End Sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Kiba" wrote in message
...
Ok I have 400 workbooks where I need to copy information into another
cell.
I need it it to search worksheet "Data Entry" for "G. Cut Length" When
it
finds that I need it to move down 16 rows. The data in that row needs to
be
saved for the find. then I need to move down another 16 rows, the data in
that cell will be what needs to replace the find data. I wand it to
search
for the find data on entire workbook and replace it with the other cell.
"G.
Cut length is always in column C but the row changes, but the data to find
is
alway 16 cells lower, and the to replace the find is always another 16.
Thanks for any help.

tricky find and replace
 

Here's what I tried and it didn't work. Any Ideas?

tricky find and replace
 

Here's what i tried and it didn't work. Any ideas?


Sub OffsetFindReplacePrint()
strFolder = "C:\Documents and Settings\dwilson\My Documents\Correction"
Set fso = CreateObject _
("Scripting.FileSystemObject")
Set Folder = _
fso.GetFolder(strFolder)

Call OffsetFindReplacePrintSubFolder(strFolder + "\")
End Sub

Sub OffsetFindReplacePrintSubFolder(strFolder)

Dim FindString As String
Dim Rng As Range
Dim ReplaceString As String


Set fso = CreateObject _
("Scripting.FileSystemObject")

Set Folder = _
fso.GetFolder(strFolder)

If Folder.subfolders.Count 0 Then
For Each sf In Folder.subfolders
On Error GoTo 100
Call OffsetFindReplacePrintSubFolder(strFolder + sf.Name + "\")
100 Next sf
End If
'folder size in bytes
On Error GoTo 200
For Each fl In Folder.Files
Ext = fso.GetExtensionName(fl)
If UCase(Left(Ext, 2)) = "XL" Then

Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(fl)
On Error GoTo 0

If Not mybook Is Nothing Then

'Change cell value(s)
On Error Resume Next

'Experimental Coding

Application.DisplayAlerts = False
Application.ScreenUpdating = False


With mybook.Worksheets("Data Entry")
FindString = Cells.Find("G. Cut Length").Offset(16)
ReplaceString = Cells.Find("G. Cut Length").Offset(32)
Set Rng = .Replace(What:=FindString, _
Replacement:=ReplaceString, _
after:=.Cells(.Cells.Count), _
Lookat:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False)




Worksheets("Report").Select
Range("I2").Select

' ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=True
End With

If Err.Number 0 Then
ErrYes = True
Err.Clear
'close without saving
mybook.Close savechanges:=False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Else
mybook.Close savechanges:=True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End If
Else
ErrorYes = True
End If
End If
Next fl
200 On Error GoTo 0

End Sub

tricky find and replace
 

Send your wb to my address below along with a clear explanation and
before/after examples

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Kiba" wrote in message
...
Here's what I tried and it didn't work. Any Ideas?