Error commonly occurs when code is incompatible - vba

I wrote a VBA module within an excel document I am working on. I got everything working on my laptop and finally published it to my team to begin a wave of testing.
Unfortunately, a lot of them are met with the following error:
Compile error in hidden module: pushEmail. This error commonly occurs when code is incompatible with the version, platform, or architecture of this application.
At first, I assumed that people were not using the same version of Excel as I was (Excel 2016), however, it turns out that they all were. Other solutions I've attempted are:
Checking the references to ensure that all were included on other user's computers. They were.
Check the add-ins I was using on excel. Besides the default ones, I had none.
Ensure I was using 32/64bit compatible code (as per a recommended solution I found through google). Me and my team all have x64 computers.
I'm not sure what else to try and I have been through the first 30 pages of Google to try and find a solution, to no avail. Could someone suggest a solution that I could attempt?
Thank you in advance.
UPDATE
Here is the code in question:
Sub AcceptPush()
Dim track As Excel.Workbook
Dim push As Excel.Workbook
Dim trackFC As Excel.Workbook
Dim trackWks As Excel.Worksheet
Dim pushWks As Excel.Worksheet
Dim FCWks As Excel.Worksheet
Dim pName As String
Dim TLPass As Variant
Dim lastrow As Long
Dim rngFoundCell As Range
Set rng = Nothing
Dim MyCell As Range
Set push = Workbooks("Push Alert - Software.xlsm")
Set pushWks = push.Worksheets("Push")
Set rngFoundCell = pushWks.Range("R11:R53").Find(What:="y")
pName = pushWks.Range("D2").Value
TLPass = InputBox("Enter the TL Password")
Select Case TLPass
Case "password"
MsgBox "Password correct"
If rngFoundCell Is Nothing Then
MsgBox "You did not select a push to accept."
Else
Set track = Workbooks.Open(ThisWorkbook.Path & "\Account Pushing Tracker - Software.xlsm")
Set trackWks = track.Worksheets("Accounts")
Set trackFC = Workbooks.Open(ThisWorkbook.Path & "\Account Pushing Tracker - Team Tax.xlsm")
Set FCWks = trackFC.Worksheets("Accounts")
pushWks.Range("PushData[#All]").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=push.Worksheets("Filter Criteria").Range("B6:Q7")
pushWks.Range("R:S").EntireColumn.Hidden = True
pushWks.Range("PushData").Copy
trackWks.Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
pushWks.Range("PushData").Copy
FCWks.Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
pushWks.Range("R:S").EntireColumn.Hidden = False
pushWks.Range("PushData").ClearContents
pushWks.ShowAllData
Range("A1").Select
Application.CutCopyMode = True
track.Close SaveChanges:=True
trackFC.Close SaveChanges:=True
End If
Case Else
MsgBox "INCORRECT! Your attempt has been recorded"
ActiveWorkbook.Worksheets("Log").Unprotect "123"
ActiveWorkbook.Worksheets("Log").Range("A" & Rows.Count).End(xlUp).Offset(1).Value = Application.UserName
ActiveWorkbook.Worksheets("Log").Range("B" & Rows.Count).End(xlUp).Offset(1).Value = Format(Now(), "dd/mm/yyyy hh:mm:ss")
ActiveWorkbook.Worksheets("Log").Protect "123"
End Select
End Sub

When I try to compile your code, it shows you haven't declared the Rng variable:
Set Rng = Nothing

this can occure if 2 Installation of Word/Excel (64 /32 ) or rest of them are on computer.
The apdada....\Excel\STARTUP must be empty too
Maybe try to deinstall all Excel entirely and after new installation try again

Related

Check if there's been data copied/pasted from a excel file (VBA)

Im going to start by telling what my intention was with this code
In my job we have to open every sales order that will be sent in that day and check for the itens to be shipped manually.
Since its very time consuming i tought in creating a worksheet that it will look for the itens in every sales order and copy/paste in my master so i can know what i need to get.
However to my sheet works I had to make a few changes in the Sales order, but now I want to create a error check, that if the file that it was open was an older SO it will tell me its order number so later i can check it.
Also i want to check if by some reason nothing was found in that SO.
Now ill explain what my code does (I have a little knowledge in coding and in excel vba, so please dont judge my ugly script)
Using the value of a cell in a range, it will open the folder and file that matches it's value, then will look for a specific range and for a specific cell value, in this case "Perfil", if this value is found it will copy some cells.
After looking for that file it will open another one and do the same.
However if "Perfil" is not found it wont copy and paste anything and it will just go to the next file.
Public Sub test()
On Error GoTo Errormsg
Dim wbk As Workbook
Dim Fonte As Workbook
Dim Dest As Workbook
Dim Filename As String
Dim FolderName As String
Dim Arquivo As String
Dim Path As String
Dim celula As Range
Dim cll As Range
Dim Inicio As Range
Dim Fim As Range
Dim OffInicio As Range
Dim OffFim As Range
Dim busca As Range
Application.ScreenUpdating = False
Set Dest = Workbooks("testee.xlsm")
Path = 'My file path
lrow = Sheets(1).Range("A" & Sheets(1).Rows.Count).End(xlUp).Row
For Each celula In Dest.Worksheets(1).Range("A3:A" & lrow)
Dest.Sheets(1).Activate
Pedido = Cells(celula.Row, 1)
FolderName = Pedido & "*"
Arquivo = "\" & Pedido
Folder = Dir(Path & FolderName, vbDirectory)
Filename = Dir(Path & Folder & Arquivo & "*.xlsx")
Set wbk = Workbooks.Open(Path & Folder & "\" & Filename, 0)
Set Fonte = Workbooks(Filename)
Fonte.Activate
Set Inicio = Fonte.Worksheets(1).Cells.Find(what:="MODO DE FIXAÇÃO DO PRODUTO")
Set Fim = Fonte.Worksheets(1).Cells.Find(what:="OBSERVAÇÕES")
Set OffInicio = Inicio.Offset(1, 0)
Set OffFim = Fim.Offset(-1, 1)
Set busca = Range(OffInicio, OffFim).Columns(5)
Set check = Range(OffInicio, OffFim).Columns(9)
Range(OffInicio, OffFim).Columns(5).Select
Set busca = Selection
For Each cl In busca
tipo = Cells(cl.Row, 5).Value
If tipo = "Perfil" Then
tamanho = Cells(cl.Row, 6).Value
expessura = Cells(cl.Row, 11).Value
cor = Cells(cl.Row, 12).Value
lrow2 = Dest.Sheets(2).Range("D" & Dest.Sheets(2).Rows.Count).End(xlUp).Row
linha = lrow2 + 1
Dest.Sheets(2).Range("D" & linha).Value = Pedido
Dest.Sheets(2).Range("E" & linha).Value = tamanho
Dest.Sheets(2).Range("H" & linha).Value = cor
End If
Next cl
End If
Next celula
Errormsg:
lrow2 = Dest.Sheets(2).Range("D" & Dest.Sheets(2).Rows.Count).End(xlUp).Row
linha = lrow2 + 1
Dest.Sheets(2).Range("D" & linha).Value = Pedido
Dest.Sheets(2).Range("E" & linha).Value = "Pedido com modelo Antigo"
End Sub
I want to know the files that no data has been copied, so I can check manually and see why it wasnt.
To do that i tought in checking if in that file any data has been copied and pasted in my master sheet, if nothing was done it will send a message in a cell telling its number so i can check it later.
Now is my question:
I dont know if is possible to check if anything was pasted from that file, in case is possible, how i do that?
I cant just check if "Perfil" exists because for my sheet works I had to change a few things in the sheets that had the data I needed, and "perfil"is not something that the older version of it had.
Also in my new version "Perfil"is not the only value that the column can have so i cant just check if perfil is not found there.
There are a few ways you can check if anything has changed in the workbook. I'd suggest this method:
In any (new or existing) standard module, add a public variable declaration at or near the top of the module:
Public wksChanged As Boolean
For each worksheet that you want to monitor for changes, open the Worksheet's module by right-clicking the worksheet's tab and clicking View Code:
...and then add this procedure (to each applicable worksheet module):
Private Sub Worksheet_Change(ByVal Target As Range)
wksChanged = True
End Sub
wksChanged will default to False when the workbook is first opened, and will change to True when any cell is changed. You can "reset" it at any time with:
wksChanged = False

Method Export of object '_Chart' failed Run-time error -2147286987 80030035

I have setup a macro assigned to a button to push a daily report to a SharePoint site. I can run the procedure and so can another user on a different computer in a different location. Two other users on separate computers in the same location cannot and get 'Run-time error -2147286987 (80030035) Method Export of object '_Chart' failed. I am at a complete loss. If those same users go into the SharePoint and manually save the same bmp to the same location they have no issues. All references are also the same. I thought it was a permissions issue but that does not appear to be the case. Any help is appreciated.
It is failing on this line:
.Chart.Export "\\sharepoint-dns.com\sites\oursharepoint\SiteAssets\SitePages\Dashboard\" & sFile & ".bmp", "BMP"
Full VBA is shown below. PublishSharePoint calls SaveImage
Sub PublishSharePoint()
'User cell selection when running macro
Dim iRowRef As Integer
Dim iColRef As Integer
Dim iLastRow As Integer
SheetRef = ActiveSheet.Name
iRowRef = ActiveCell.Row
iColRef = ActiveCell.Column
'Unprotect Sheet
'Worksheets("Dashboard_3").Unprotect
Call SaveImage("Dashboard_3", "B5:O76", "Dashboard")
'Protect Sheet
'Worksheets("Dashboard_3").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
'Return to starting cell
Worksheets(SheetRef).Activate
Cells(iRowRef, iColRef).Select
End Sub
...
Sub SaveImage(sSheet As String, sRange As String, sFile As String)
Worksheets(sSheet).Activate
Set Plage = ThisWorkbook.Worksheets(sSheet).Range(sRange)
Plage.CopyPicture
With ThisWorkbook.Worksheets(sSheet).ChartObjects.Add(Plage.Left, Plage.Top, Plage.Width, Plage.Height)
.Activate
.Chart.Paste
.Chart.ChartArea.Border.LineStyle = xlNone
'.Chart.Export "C:\...\" & nameFile & ".png", "PNG"
'.Chart.Export "C:\...\" & nameFile & ".jpg", "JPG"
.Chart.Export "\\sharepoint-dns.com\sites\oursharepoint\SiteAssets\SitePages\Dashboard\" & sFile & ".bmp", "BMP"
End With
Worksheets(sSheet).ChartObjects(Worksheets(sSheet).ChartObjects.Count).Delete
Set Plage = Nothing
End Sub
I don't know enough to explain the root cause in detail but this seems to be related to the webdav path requiring network credentials in some instances. As a work around I mapped the SharePoint path as a network drive and this works for all users.
Dim oNetwork As Object
Set oNetwork = CreateObject("WScript.Network")
oNetwork.MapNetworkDrive "Z:", "http://sharepoint-dns.com/sites/oursharepoint/SiteAssets/SitePages/Dashboard", False
remember to disconnect the drive...
oNetwork.RemoveNetworkDrive "Z:"

VBA runtime error 13 using Msgbox

I'm very new to VBA and only have a basic level of knowledge.
I have been trying to create a macro to cross-reference data on one sheet against multiple other sheets within the same work book. If a record is found I would like a msgbox to appear to alert the user of the location of the data.
After many hours searching the internet and piecing together bits of code this is what I have
Sub search()
Dim ws As Worksheet, found As Range
Dim TextToFind(1 To 20) As String
Dim iText As Long
TextToFind(1) = "Jade Smith"
TextToFind(2) = "Bob Collins"
TextToFind(3) = "Jemima Smythe"
For Each ws In ThisWorkbook.Worksheets
With ws
If .Name <> "Blacklisted Candidates" Then 'Do not search blacklist candidates!
iText = 1
Do While iText <= UBound(TextToFind)
If TextToFind(iText) <> "" Then 'Do not search blank strings!
Set found = .UsedRange.Find(what:=TextToFind(iText), LookIn:=xlformulas, LookAt:=xlPart, MatchCase:=False)
If Not found Is Nothing Then
MsgBox "Proxy Candidate Found at " & found.Address
Else
MsgBox "No Proxy Candidates Found ", vbOKOnly, "Success!"
End If
iText = iText + 1
End If
Loop
End If
End With
Next ws
End Sub
This code however doesn't find the values from other sheets.
when testing this I just get the msgbox when no data has been found even though there is test data there.
I have a workbook of approx 9 sheets (ever growing) and I want to search the first 9 columns of each work book for the specified data which as you can see I have manually input into the macro but when running the macro I get no results returned even though there is data to find.
You are trying to use the binary operator And on two strings. You probably meant to use & instead to concatenate strings.
Documentation :
And
&
(The docs are for VB.Net, but they work the same in both languages)
So to fix it, replace
MsgBox ("Proxy Candidate Found at " And rngX.Address)
By
MsgBox ("Proxy Candidate Found at " & rngX.Address)
edited to account for searching in cell whose content derives from a formula
to both summarize all what has been already pointed out in comments and litelite answer and add some 0.02 cents, here a working code
Option Explicit
Sub search()
Dim ws As Worksheet, found As Range
Dim TextToFind(1 To 20) As String
Dim iText As Long
TextToFind(1) = "xxxx"
TextToFind(2) = "xxxx"
TextToFind(3) = "xxxxx"
For Each ws In ThisWorkbook.Worksheets
With ws
If .name <> "Blacklisted Candidates" Then 'Do not search blacklist candidates!
iText = 1
Do While iText <= UBound(TextToFind)
If TextToFind(iText) <> "" Then 'Do not search blank strings!
Set found = .UsedRange.Find(what:=TextToFind(iText), LookIn:=xlFormulas, LookAt:=xlPart, MatchCase:=False)
If Not found Is Nothing Then
MsgBox "Proxy Candidate Found at " & found.Address
Else
MsgBox "No Proxy Candidates Found ", vbOKOnly, "Success!"
End If
iText = iText + 1
End If
Loop
End If
End With
Next ws
End Sub

Excel 2013 - VBA - Copy to next open row on target workbook

I have been able to get quite far on my project by using a lot of the solutions posted on here. Unfortunately, I simply cannot workout the bugs and could really use some help. What I am trying to accomplish is as follows:
-"CNC WORK ORDER REQUEST - V2.XLSM" is the source workbook where a department will input their requests for any sort of CNC work. I have formatted it so the output is consistent. A whole department of people will have access to it on their local computers.
-"MASTER SCHEDULE.XLSX" is the target workbook where I would like a particular range of cells copied to, on the next available row of cells in this workbook. This workbook is for upper management to have visibility on a "master schedule" that is created by the submissions of the CNC WORK ORDER REQUEST workbook.
I do feel that the WORKORDER REQUEST is fine, but I am having issue with copying to the next open row of cells on the MASTER SCHEDULE. I cannot get all of the cells to copy to the next open row.
The code I have is as follows:
Sub Auto_Open()
MsgBox "Welcome, please enter information in *ALL* subsquent prompts as instructed."
Dim Customer
Customer = InputBox("Enter customer name")
Range("e1") = Customer
Dim Job
Job = InputBox("Enter Job#")
Range("e2") = Job
Dim JobName
JobName = InputBox("Enter job name / description")
Range("e3") = JobName
Dim TodaysDate
TodaysDate = InputBox("Enter today's date")
Range("E4") = TodaysDate
Dim Manager
Manager = InputBox("Enter your Intials")
Range("e5") = Manager
MsgBox "Before entering which machine will run this part, you must get this information from Ronnie", vbOKOnly
Dim Machine
Machine = InputBox("Enter which machine this will be run on. Options are: Thermwood -or- MultiCam")
Range("b9") = Machine
Dim Part
Part = InputBox("Enter part name as per drawing")
Range("B10") = Part
Dim Qty
Qty = InputBox("Enter Qty needed including overs")
Range("B11") = Qty
Dim Material
Material = InputBox("Enter material type with details")
Range("B12") = Material
Dim Thickness
Thickness = InputBox("Enter material thickness")
Range("b13") = Thickness
Dim EdgeFinish
EdgeFinish = InputBox("Enter edge finish for this part - MILL FINISH, FLAME POLISH, DIAMOND POLISH, DIAMOND AND BUFF")
Range("B14") = EdgeFinish
Dim MaterialInHouse
Material = InputBox("If material is in house, type YES, if not, enter the ETA")
Range("B15") = MaterialInHouse
Dim AddtionalProcessing
AddtionalProcessing = InputBox("Please note any subsequent processing required")
Range("B16") = AddtionalProcessing
Dim NeedBy
NeedBy = InputBox("Enter required completion date for parts")
Range("B17") = NeedBy
Dim AddtionalNotes
AddtionalNotes = InputBox("Enter any additional notes, if required")
Range("B18") = AddtionalNotes
'TESTING - TO COPY ABOVE VALUES TO MASTER SCHEDULE'
'Dim wbk As Workbook
'Dim strFirstFile As String
'Dim strSecondFile As String
'strFirstFile = "CNC WORK ORDER REQUEST - V2.XLSM"
'strSecondFile = "C:\Users\Mike\Desktop\MASTER SCHEDULE.XLSX" 'CHANGE TO TARGET FILE ONCE DETERMINED
'CUSTOMER COPY:
'Set wbk = Workbooks(strFirstFile)
'With wbk.Sheets("sheet1")
'.Range("E1").Copy
'End With
'Set wbk = Workbooks.Open(strSecondFile)
'With wbk.Sheets("sheet1").Range("b" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial(xlPasteValues)
'End With
'JOB# COPY:
'Set wbk = Workbooks(strFirstFile)
'With wbk.Sheets("sheet1")
'.Range("E2").Copy
'End With
'Set wbk = Workbooks(strSecondFile)
'With wbk.Sheets("sheet1").Range("C" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
'End With
'wbk.Save
'wbk.Close
'END TESTING
MsgBox "Please print and submit to Ronnie.", vbOKOnly 'ADD COMMENT BELOW BACK UP HERE ONCE SCHEDULE COMPLETE
'Workorder has already been uploaded to schedule",
End Sub
Sorry if I did not articulate myself well enough with what I'm trying to accomplish. I tried posting images, but was not allowed. I am really looking forward to solving this as it will help organize the company I am working with. Thanks in advance!
Kind regards,
Mike Q
Without seeing the sheets it's impossible for me to know where to paste to, but it looks like your problem is your only copying one cell at a time so that's all that will copy. You need to copy the entire range and then if you paste it to the first open cell in your destination sheet it will paste everything.
You will probably still need to tweak this a bit but hopefully it will give you enough to work with:
'TESTING - TO COPY ABOVE VALUES TO MASTER SCHEDULE'
Dim wbk As Workbook
Dim strFirstFile As String
Dim strSecondFile As String
strFirstFile = "CNC WORK ORDER REQUEST - V2.XLSM"
strSecondFile = "C:\Users\Mike\Desktop\MASTER SCHEDULE.XLSX"
'CUSTOMER Copy:
Set wbk = Workbooks(strFirstFile)
wbk.Sheets("sheet1").Range("E1:E5").Copy
Set wbk = Workbooks.Open(strSecondFile)
wbk.Sheets("sheet1").Range("B1").End(xlDown).Offset(1, 0).PasteSpecial (xlPasteValues)
'JOB# Copy:
Set wbk = Workbooks(strFirstFile)
wbk.Sheets("sheet1").Range("B9:B18").Copy
Set wbk = Workbooks(strSecondFile)
wbk.Sheets("sheet1").Range("C1").End(xlDown).Offset(1, 0).PasteSpecial
wbk.Save
wbk.Close
'END TESTING
Just an FYI, if you're looking for the user to input a lot of data check into making a userform. They're not hard to make and will be much easier for your users to input a bunch of data. It also gives you some control over validating it.

Excel VBA Runtime Error 1004 when renaming ActiveSheet

I'm at a loss when trying to figure out where this code is tripping up. I am looking to rename the activesheet by using a concat of two ranges on the activesheet and some static text. When only one worksheet is in the workbook, the code works great. As soon as a second worksheet is added, I get a Runtime Error 1004. I'll highlight the line of code where it is breaking. This code currently resides in a normal module.
Option Explicit
Sub updateName()
Dim fNumber
Dim pCheckNumber
Dim asName As String
Dim tempASName As String
Dim worksheetName As Object
If ActiveSheet.Name = "Launch Page" Then Exit Sub
fNumber = ActiveSheet.Range("FlightNumber").Value
pCheckNumber = ActiveSheet.Range("PerformanceCheckNumber").Value
If fNumber <> "" And pCheckNumber <> "" Then
tempASName = "Flight " & fNumber & " | Run " & pCheckNumber & " (0.0%)"
asName = tempASName
MsgBox ActiveSheet.Name & vbCr & asName
ActiveSheet.Name = asName
worksheetName.Caption = asName
Else
Exit Sub
End If
End Sub
I'm in the process of adding error checking to ensure that I don't have duplicate sheet names. However, due to the nature of the field names, this will never occur.
I appreciate all of the insights!
The error you are reporting is, most likely, provoked because of trying to rename a Worksheet by using a name already in use. Here you have a small code to avoid this kind of situations:
Dim newName As String: newName = "sheet1"
Dim addition As String: addition = "_2"
Do While (Not sheetNameFree(newName))
newName = newName & addition
Loop
Where sheetNameFree is defined by:
Function sheetNameFree(curName As String) As Boolean
sheetNameFree = True
For Each Sheet In ActiveWorkbook.Sheets
If (LCase(Sheet.Name) = LCase(curName)) Then
sheetNameFree = False
Exit Function
End If
Next Sheet
End Function
You can adapt this code to your specific needs (for example, by converting addition into a number which grows after each wrong name).
In your code I see one other problem (although it shouldn't be triggering a 1004 error): you are accessing the property Caption from an non-instantiated object (worksheetName), whose exact functionality is not too clear. Just delete this line.
NOTE: good point from KazJaw, you might be using an illegal character. If fNumber and pCheckNumber are numbers or letters, it would be OK.
NOTE2: if with worksheetName you want to refer to an ActiveX Label in your workSheet, better do: ActiveSheet.Label1.Caption (where Label1 is the name of the Label). You cannot define worksheetName as a Label, because it is not a "conventional Label".