ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   linking files-update a cell in several workbooks (https://www.excelbanter.com/excel-programming/412325-linking-files-update-cell-several-workbooks.html)

Kiba

linking files-update a cell in several workbooks
 
Is there a way I can create a workbook that contains a list of excel workbook
files and just use a check box to select the ones I want to update and then
write a vb code to update a specific cell on a specific sheet of each work
book. Wb's have different names but sheet names, and cell location will be
the same for each.



Ron de Bruin

linking files-update a cell in several workbooks
 
You can use this macro to create links
http://www.rondebruin.nl/summary2.htm

Or use this add-in to get the values you want
http://www.rondebruin.nl/merge.htm

Or with code
http://www.rondebruin.nl/copy3.htm

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Kiba" wrote in message ...
Is there a way I can create a workbook that contains a list of excel workbook
files and just use a check box to select the ones I want to update and then
write a vb code to update a specific cell on a specific sheet of each work
book. Wb's have different names but sheet names, and cell location will be
the same for each.



Ron de Bruin

linking files-update a cell in several workbooks
 
Hi Kiba

If you want to replace the value then use Replace instead of find
Record a macro when you do it manual and you have the code


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Kiba" wrote in message ...
Here's the code i got but I know I doing something wrong...how do I get it to
change the value once I find it? And where would I tell it to make other
changes if it finds that value. Also can I have it call a macro in the
workbook it opens to update it?

Sub UpdateCutLengthTarget()
Dim Mypath As String, FilesInPath As String
Dim MyFiles() As String, Fnum As Long
Dim mybook As Workbook
Dim CalcMode As Long
Dim sh As Worksheet
Dim ErrorYes As Boolean

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


'Experimental

FindString = InputBox("Enter a Search Value")
ReplaceString = InputBox("Enter Value to Replace with")


'Path to Folders where the files are.
Mypath = "C:\Documents and Settings\dwilson\Desktop\Mill Work"

'Add a slash at the end if the user forgot it
If Right(Mypath, 1) < "/" Then
Mypath = Mypath & "/"
End If

'If there are no Excel Files in the folder exit the sub
FilesInPath = Dir(Mypath & "*.xl*")
If FilesInPath = "" Then
MsgBox "No files found."
Exit Sub
End If

'Fill the array (myFiles) with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath < ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop


'Loop through all file in array
If Fnum 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(Mypath & MyFiles(Fnum))
On Error GoTo 0

If Not mybook Is Nothing Then

'Change cell value(s)
On Error Resume Next


'Experimental Coding


If Trim(FindString) < "" Then
With Sheets("Data Entry").Range("C:C")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
Lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)




If Not Rng Is Nothing Then
Rng = ReplaceString
Else
MsgBox "Nothing Found"
End If

End With
End If



















If Err.Number 0 Then
ErrYes = True
Err.Clear
'close without saving
mybook.Close savechanges:=False
Else
mybook.Close savechanges:=True
End If
Else
ErrorYes = True
End If

Next Fnum

End If

If ErrorYes = True Then
MsgBox "There are problems in one or more files, possible problem:" _
& vbNewLine & "protected workbook/sheet or a sheet/range that not exist"
End If

With Application
.ScreenUpdating = True
.EnableEvents = True
End With




End Sub


Kiba

linking files-update a cell in several workbooks
 
I'm still utterly lost.

"Ron de Bruin" wrote:

Hi Kiba

If you want to replace the value then use Replace instead of find
Record a macro when you do it manual and you have the code


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Kiba" wrote in message ...
Here's the code i got but I know I doing something wrong...how do I get it to
change the value once I find it? And where would I tell it to make other
changes if it finds that value. Also can I have it call a macro in the
workbook it opens to update it?

Sub UpdateCutLengthTarget()
Dim Mypath As String, FilesInPath As String
Dim MyFiles() As String, Fnum As Long
Dim mybook As Workbook
Dim CalcMode As Long
Dim sh As Worksheet
Dim ErrorYes As Boolean

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


'Experimental

FindString = InputBox("Enter a Search Value")
ReplaceString = InputBox("Enter Value to Replace with")


'Path to Folders where the files are.
Mypath = "C:\Documents and Settings\dwilson\Desktop\Mill Work"

'Add a slash at the end if the user forgot it
If Right(Mypath, 1) < "/" Then
Mypath = Mypath & "/"
End If

'If there are no Excel Files in the folder exit the sub
FilesInPath = Dir(Mypath & "*.xl*")
If FilesInPath = "" Then
MsgBox "No files found."
Exit Sub
End If

'Fill the array (myFiles) with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath < ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop


'Loop through all file in array
If Fnum 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(Mypath & MyFiles(Fnum))
On Error GoTo 0

If Not mybook Is Nothing Then

'Change cell value(s)
On Error Resume Next


'Experimental Coding


If Trim(FindString) < "" Then
With Sheets("Data Entry").Range("C:C")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
Lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)




If Not Rng Is Nothing Then
Rng = ReplaceString
Else
MsgBox "Nothing Found"
End If

End With
End If



















If Err.Number 0 Then
ErrYes = True
Err.Clear
'close without saving
mybook.Close savechanges:=False
Else
mybook.Close savechanges:=True
End If
Else
ErrorYes = True
End If

Next Fnum

End If

If ErrorYes = True Then
MsgBox "There are problems in one or more files, possible problem:" _
& vbNewLine & "protected workbook/sheet or a sheet/range that not exist"
End If

With Application
.ScreenUpdating = True
.EnableEvents = True
End With




End Sub




All times are GMT +1. The time now is 08:46 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com