M
mrstarface
I've got some VBA in Excel which at the moment opens up spreadsheets and
replaces 0.025 with 0.035.
I need to add some more vba in to change the column width of "Column A"
in all the worksheets within the spreadsheet except for one which is
labelled "Main Menu".
Unfortunately I did not write the original VBA and have tried very
unsuccefully to build this extra command in. I need to retain the
orgiinal functionality which opens up all the spreadsheets with the
directory one by one as have nearly 400 to change!
Can anyone help me out, here's the current VB code I'm using:
Sub replacestringall()
Dim strFile As String
Dim wbkExcel As Excel.Workbook
Dim appExcel As Excel.Application
Dim strThisDoc As String
Dim strPath As String
Dim i As Byte
strThisDoc = ActiveWorkbook.Name
strPath = ActiveWorkbook.Path
Set appExcel = New Excel.Application
appExcel.WindowState = xlMinimized
appExcel.Visible = True
With Application.FileSearch
LookIn = strPath
FileType = msoFileTypeExcelWorkbooks
SearchSubFolders = True
Execute
Range("A1") = "0 / " & .FoundFiles.Count
For i = 1 To .FoundFiles.Count
If Right(.FoundFiles(i), 4) = ".xls" Then
If InStr(.FoundFiles(i), "~$") = 0 Then
If .FoundFiles(i) <> strPath & "\" & strThisDoc Then
On Error Resume Next
Set wbkExcel =
appExcel.Workbooks.Open(Filename:=.FoundFiles(i))
Select Case Err.Number
Case 0
Range("A2") = .FoundFiles(i)
wbkExcel.Activate
Dim sht As Excel.Worksheet
For Each sht In wbkExcel.Worksheets
sht.Unprotect Password:="mj22st"
appExcel.DisplayAlerts = False
sht.Cells.Replace What:="0.025,",
Replacement:="0.035,", LookAt:=xlPart, SearchOrder:=xlByRows,
MatchCase:=False
appExcel.DisplayAlerts = True
Next
wbkExcel.Save
wbkExcel.Close wdDoNotSaveChanges
Case 5408
Case Else
MsgBox Err.Number & ": " & Err.Description
End Select
On Error GoTo 0
Set wbkExcel = Nothing
End If: End If: End If
ActiveWindow.Activate
ActiveWorkbook.Activate
Range("A1") = i & " / " & .FoundFiles.Count
DoEvents
Next
End With
appExcel.Quit
Set appExcel = Nothing
Range("A2") = ""
End Sub
Thanks any help appreciated!
replaces 0.025 with 0.035.
I need to add some more vba in to change the column width of "Column A"
in all the worksheets within the spreadsheet except for one which is
labelled "Main Menu".
Unfortunately I did not write the original VBA and have tried very
unsuccefully to build this extra command in. I need to retain the
orgiinal functionality which opens up all the spreadsheets with the
directory one by one as have nearly 400 to change!
Can anyone help me out, here's the current VB code I'm using:
Sub replacestringall()
Dim strFile As String
Dim wbkExcel As Excel.Workbook
Dim appExcel As Excel.Application
Dim strThisDoc As String
Dim strPath As String
Dim i As Byte
strThisDoc = ActiveWorkbook.Name
strPath = ActiveWorkbook.Path
Set appExcel = New Excel.Application
appExcel.WindowState = xlMinimized
appExcel.Visible = True
With Application.FileSearch
LookIn = strPath
FileType = msoFileTypeExcelWorkbooks
SearchSubFolders = True
Execute
Range("A1") = "0 / " & .FoundFiles.Count
For i = 1 To .FoundFiles.Count
If Right(.FoundFiles(i), 4) = ".xls" Then
If InStr(.FoundFiles(i), "~$") = 0 Then
If .FoundFiles(i) <> strPath & "\" & strThisDoc Then
On Error Resume Next
Set wbkExcel =
appExcel.Workbooks.Open(Filename:=.FoundFiles(i))
Select Case Err.Number
Case 0
Range("A2") = .FoundFiles(i)
wbkExcel.Activate
Dim sht As Excel.Worksheet
For Each sht In wbkExcel.Worksheets
sht.Unprotect Password:="mj22st"
appExcel.DisplayAlerts = False
sht.Cells.Replace What:="0.025,",
Replacement:="0.035,", LookAt:=xlPart, SearchOrder:=xlByRows,
MatchCase:=False
appExcel.DisplayAlerts = True
Next
wbkExcel.Save
wbkExcel.Close wdDoNotSaveChanges
Case 5408
Case Else
MsgBox Err.Number & ": " & Err.Description
End Select
On Error GoTo 0
Set wbkExcel = Nothing
End If: End If: End If
ActiveWindow.Activate
ActiveWorkbook.Activate
Range("A1") = i & " / " & .FoundFiles.Count
DoEvents
Next
End With
appExcel.Quit
Set appExcel = Nothing
Range("A2") = ""
End Sub
Thanks any help appreciated!