I've created a function which checks if a sheet exists in an external workbook. Code as follows (I've checked this and this works perfectly with other sheets, commenting out the If statement that references this stops the error):
Function ExtSheetExists(formString) As Boolean
Dim val As Variant
On Error Resume Next
val = ExecuteExcel4Macro(formString)
ExtSheetExists = (val <> Error(2023))
On Error GoTo 0
End Function
Note: FormString is passed as "'" & wkBookRef1 & firstShtName & "'!" & "R6C12" where wkBookRef1 is just the path to the spreadsheet and firstShtName is the spreadsheet name that is being looked up.
However later when I go to update the same spreadsheet using the UpdateLink method it pops up the Select Sheet dialogue box and thus stops the run of the macro. Does anyone have an inkling as to what is going on here?
The select sheet box is as follows:
It's a bug. Effectively the formstring is run and the message box is suppressed. However it seems that it remains as a latent process in the other spreadsheet. So when it is updated it shows the suppressed message box.
Related
I have been working on debugging this code and I am running into an issue where the code runs fine (no errors) but the changes it is supposed to be making aren't happening in the actual sheet.
What the code is supposed to do:
The goal is to be able to check on saving if any cells have been changed. If they have, it locks all cells with non-blank values and protects the sheet to avoid having those cells edited in future instances.
Here is the code itself:
Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim sMSG As String
sMSG = "Saving the workbook will lock the cells you have entered data into." & vbLf
sMSG = sMSG & "Do you want to go ahead?"
If Not bRangeEdited Then GoTo Xit
If Not Me.ReadOnly Then
Sheet1.Unprotect "password"
With Sheet1.Range("A1:I20")
If MsgBox(sMSG, vbExclamation + vbYesNo) = vbNo Then
Cancel = True
GoTo Xit
End If
If .SpecialCells(xlCellTypeBlanks).Address <> .Address Then
.SpecialCells(xlCellTypeConstants).Locked = True
bRangeEdited = False
End If
End With
Sheet1.Protect Password:="password", UserInterFaceOnly:=True, DrawingObjects:=False, AllowFiltering:=True
End If
Xit:
End Sub
This is based on a common piece of code found on multiple forums which seems to work for everyone else. This code USED to work and then something broke it. I thought it was the Range being wrong (which I fixed) but that didn't solve the problem.
What I've tried:
Running the separate code lines in the Immediate window - everything runs properly
Stepping through the code with F8 and debug.print to check what is being pulled by .SpecialCells(xlCellTypeBlanks).Address - this pulls the entire input range every time, regardless of what is in the cells but pulls the correct range when run in the Immediate window
Stepping through also produces no errors and shows that every if and with statement is working correctly
Running the code from different locations (Sheet1, Module, ThisWorkbook) including separating into multiple subs across different locations - no change
Running the code on a brand-new test workbook with no other macros - still doesn't work
Different methods for locking the cells such as a loop through all cells in the range instead of using SpecialCells - didn't work
Even the Protect/Unprotect lines are not working which leads me to believe that the code is somehow disconnected from the worksheet itself.
Anyone have any ideas how that is possible? Or how to fix it?
I made a macro that combines three reports in to one.
I first find the dynamic name by looking at open workbooks to find a matching name
For Each wk In Workbooks
If Left(wk.Name, 14) = "PayrollSummary" Then
Set wbpay = Workbooks(wk.Name)
End If
If Left(wk.Name, 12) = "PunchedHours" Then
Set wbpun = Workbooks(wk.Name)
End If
Next
And from the start this line worked (ws is the report it's working on).
ws.Range("K5").Formula = "=IFERROR(VLOOKUP(A5,['" & wbpay.Name & "']payrollsummary!$B:$B,1,FALSE),""Fel"")"
Then that line started acting up and this worked:
ws.Range("K5").Formula = "=IFERROR(VLOOKUP(A5,[" & wbpay.Name & "]payrollsummary!$B:$B,1,FALSE),""Fel"")"
Now I have added a third:
On Error Resume Next
ws.Range("K5").Formula = "=IFERROR(VLOOKUP(A5,['" & wbpay.Name & "']payrollsummary!$B:$B,1,FALSE),""Fel"")"
ws.Range("K5").Formula = "=IFERROR(VLOOKUP(A5,[" & wbpay.Name & "]payrollsummary!$B:$B,1,FALSE),""Fel"")"
ws.Range("K5").Formula = "=IFERROR(VLOOKUP(A5,'[" & wbpay.Name & "]payrollsummary'!$B:$B,1,FALSE),""Fel"")"
On Error GoTo 0
Because today only the third line worked.
Here is an example of the formula in the Excel:
The workbook name will always be ParollSummary_DateFrom_DateTo_SomeRandomStuff.xlsx.
Looking at the image it seems I have accidentally downloaded the file twice (1).
But either way, I still don't see the reason why three different lines of code works randomly (my impression) with different files.
Is there any way to make sure it will always work so that I don't need to find out what will be the correct way next week?
Apologies for posting an "Answer" here but the discussion is running out of space. Let's look at your code in detail.
For Each wk In Workbooks
If Left(wk.Name, 14) = "PayrollSummary" Then
Set wbpay = Workbooks(wk.Name)
End If
If Left(wk.Name, 12) = "PunchedHours" Then
Set wbpun = Workbooks(wk.Name)
End If
Next
It's not clear why a workbook name that starts with "PayrollSummary" should be checked whether it also starts with "PunchedHours". The two are mutually exclusive. When both are found the search should stop and when one of them isn't found the rest of your macro shouldn't be executed. Either of these things could happen with your above code leading to the errors that follow later. The code below wouldn't have the faults just described.
Sub Trial()
Dim WbPay As Workbook
Dim WbPun As Workbook
If GetWorkbook(WbPay, "PayrollSummary") Then
If Not GetWorkbook(WbPun, "PunchedHours") Then Exit Sub
' continue your code here
Debug.Print WbPay.Name
Debug.Print WbPun.Name
End If
End Sub
Private Function GetWorkbook(Wb As Workbook, _
WbName As String) As Boolean
For Each Wb In Workbooks
If InStr(1, Wb.Name, WbName, vbTextCompare) = 1 Then
GetWorkbook = True
Exit For
Next Wb
End Function
Now we know that the rest of the code can't fail because one of the workbooks wasn't found. Both WbPay and WbPun actually exist and are open.
That leads to the question why we need to use a worksheet function to access them. Since all their content is accessible, why not just get it? But you want this:-
=IFERROR(VLOOKUP(A5,['ParollSummary_DateFrom_DateTo_SomeRandomStuff.xlsx']payrollsummary!$B:$B,1,FALSE),"Fel")
There are three questions attached to this demand.
In which workbook is the formula? Bear in mind that A5 is on the ActiveSheet of that workbook. What will happen if the sheet on which the formula is entered isn't active at that time? I don't know but if Excel would attempt to execute the formula in such a scenario an error must occur - probably an error 1004.
'ParollSummary_DateFrom_DateTo_SomeRandomStuff.xlsx' should be WbPay.Name. Why not use that definition? It would guarantee that the referenced workbook really exists and is open. We don't know that of 'ParollSummary_DateFrom_DateTo_SomeRandomStuff.xlsx'. In fact, the name contains a spelling error even here (lifted from your published code).
Why do you wish to return a value from columns(1) of the look-up array? That would be the same value as you have in A5. Not that this would cause an error in itself but it adds to the general confusion.
The verdict, therefore, is that your plan is high in risk and low in precision. The solution must be in reducing the risk and increasing the precision.
I am using a macro to copy a sheet (called Copy) from the source (called Book1.xlsm) to copy a sheet to the target workbook (called Book2.xlsb). Before I do the copy, I call a macro in the target (Book2.xlsb) to make certain it's an older version.
Excel crashes or gives an Automation Error Exception Occurred or just a crash when the target workbook is closed (with both saving or not saving).
When I do this from a blank xlsm or xlsb, there is no crash. I use any of 10 real world spreadsheets (from 2MB up to 34MB xlsb), and it happens all the time.
I've spent days trying to make the minimal viable example crash with a smaller spreadsheet as a target with no luck.
The target spreadsheets contain no vba code (just formulas) except for the module that gets imported from the source.
My example has Button1 to make a single copy. 1 field exists for version number (Cell A2).
I am left with the impression that calling code in another workbook is just a bad idea or I'm missing something fundamental. If the call to the target worksheet is not made, everything runs fine.
Main Question: Is running code from another workbook just a bad idea or am I missing something?
Before saving I've tried:
Application.Calculate
Do Until (Application.CalculationState = xlDone) And _
(Application.Workbooks.Count <> 1) And _
(Application.VBE.VBProjects.Count
DoEvents
Loop
TmpTgtWorkbook.Close False
Set TmpTgtWorkbook = Nothing
Before opening, I always make certain only the source workbook is open.
Option Explicit
Function GetVersion(aWorkbook As Workbook) As Double
Dim TmpSheet As Worksheet
GetVersion = 0
On Error Resume Next
Set TmpSheet = aWorkbook.Sheets("Copy")
On Error GoTo 0
If TmpSheet Is Nothing Then
Exit Function
End If
GetVersion = CDbl(TmpSheet.Range("B1"))
End Function
Sub CopyToBook2()
Dim TmpTgtWorkbook As Workbook
Dim TmpSrcVersion As Double
Dim TmpTgtVersion As Double
Const kWorkbookStr = "Book2.xlsb"
TmpSrcVersion = GetVersion(ThisWorkbook)
ThisWorkbook.VBProject.VBComponents("Module1").Export "C:\Temp\Module1"
Set TmpTgtWorkbook = Application.Workbooks.Open(Filename:=ThisWorkbook.Path + "\" + kWorkbookStr)
Err.Clear
On Error Resume Next
'Run the GetVersion Function from the Opened Workbook.
'Removing this line takes away crashes.
TmpTgtVersion = Application.Run(kWorkbookStr + "!GetVersion", TmpTgtWorkbook)
If Err.Number <> 0 Then
Err.Clear
TmpTgtVersion = 0
End If
On Error GoTo 0
If TmpSrcVersion > TmpTgtVersion Then
On Error Resume Next
TmpTgtWorkbook.VBProject.VBComponents.Remove TmpTgtWorkbook.VBProject.VBComponents("Module1")
Application.DisplayAlerts = False
TmpTgtWorkbook.Sheets("Copy").Delete
Application.DisplayAlerts = True
On Error GoTo 0
TmpTgtWorkbook.VBProject.VBComponents.Import "C:\Temp\Module1"
ThisWorkbook.Sheets("Copy").Copy TmpTgtWorkbook.Sheets(1)
TmpTgtWorkbook.ChangeLink ThisWorkbook.Name, TmpTgtWorkbook.Name, xlLinkTypeExcelLinks
TmpTgtWorkbook.Close True
Else
TmpTgtWorkbook.Close False
End If
End Sub
Automation Error Exception Occurred and then a crash or just a crash.
Also, you need to run the code by clicking Button1 2x or more to first copy the module to the target.
I went with Abdes Sabor's workaround. Thanks for that.
Also, considering a small version system for the future which code modules have the CodeModuleName_Major_Minor version format.
My Main Question: Is running code from another workbook just a bad idea or am I missing something?
Unfortunately, all evidence point to Yes. Running a function using Application.Run in another worksheet seems to be bad and potentially corrupts spreadsheets.
So I have Cut and paste (First Mistake) my .xlsm Workbook over the previous copy and it just disappeared, After refreshing the folder it was there again but corrupted, Excel Repaired the file saying that it repaired the cause of the problem which was "Repaired Records: Drawing from /xl/drawings/drawing7.xml part (Drawing shape)". Great! So I went back to working and when I execute this code it keeps giving an error and after that I get "Out of Memory" Errors and I cannot save the workbook.
I Am Running on a 64-bit excel an Have 8Gb of RAM so its maybe not actual memory. I have tried removing the code and using other code on another sheet but still does the same. Also when I save the workbook after removing the code. It corrupts again when opening
Private Sub BtnNoticeRemove_Click()
Dim Lastrow, a As Long
If Sheets("Admin").cbxNotice.Text = "" Then
MsgBox "No data Selected"
End
End If
a = 2
Lastrow = Sheets("BP").Cells(Rows.Count, 19).End(xlUp).Row
Do Until a = Lastrow + 1
If Sheets("Admin").cbxNotice.Text = Sheets("BP").Cells(a, 19).Value Then
Sheets("BP").Cells(a, 19).Delete Shift:=xlUp
Lastrow = Sheets("BP").Cells(Rows.Count, 19).End(xlUp).Row
Sheets("BP").Range("S2:S" & Lastrow).Sort Key1:=Range("S2"),
Order1:=xlAscending
End If
a = a + 1
Loop
End Sub
EDIT:
Thx for the feedback guys, Okay so I managed to recreate all my data an Macro codes. No Corrupt errors anymore, but I Still get a Out of Memory error on the code above, After the sort is completed, at the
Sheets("Admin").cbxNotice.Text
It gives the error
I got it to work, The issue was cbxNotice was a listbox in a sheet that referenced from my Backpage Sheet, the issue was in the loop it deletes from the Backpage sheet that the listbox referenced from that cause my loop to just continue, it completely ignored the Until and variable a just went on until the program error ed "out of memory".
So What I did to make it work, was clear the reference from the listbox and add those values into the listbox with macro code
I set up a excel sheet with drop-down menus for some of the cells. The
user can only select values from that list and an error message pops up
when something is typed it that is not in the list (via Data Validation
Error Alert).
So this works all fine ... But when the user copy paste into the cells then validation doesnt work. How to make validation effective in case of copy paste.
I have searched and found one solution but its not working.
Here is the code that I have found. but its not working any more..It always return true enven I copy paste worng
Private Sub Worksheet_Change(ByVal Target As Range)
If HasValidation(Range(ActiveCell.Address)) Then
Exit Sub
Else
Application.Undo
MsgBox "Your last operation was canceled." & _
"It would have deleted data validation rules.", vbCritical
End If
End Sub
Private Function HasValidation(r) As Boolean
On Error Resume Next
x = r.Validation.Type
If Err.Number = 0 Then HasValidation = True Else HasValidation = False
End Function
It looks like you took the code from this page:
http://www.j-walk.com/ss/excel/tips/tip98.htm
When Worksheet_Change fires, your code always refers to the active cell, not the target where the copy/paste operation is being performed.
Change
ActiveCell.Address
to
Target.Address
and see if that works.
The "Target.Address" worked for me as mentioned by #JimmyPena.
But the solution still brings a bug, that if one tries to add another validation after adding the above mentioned VB code, the user is fired with the amount of message boxes produced by the vb code which is applied to the number of cells (viz. You will have to click on "OK" of the message box provided by the VB code for the number of cells the VB code has been applied to.. If code applied to 40 cells then you have to click "OK" 40 times... phew..)
Can you please try to help to add another condition to help this?
Or the last way that remains to only add the VB code after adding all the validations.