tricky find and replace

[Kiba]

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.

 

[Kiba]

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

 

[Don Guillett]

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

 

[Kiba]

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

 

[Kiba]

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

 

[Don Guillett]

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