I am currently linking lots of subs together to format headings in excel for upload to other dashboard software. The headings need to be in a certain order. I am running several subs triggered by a command button to search for the heading text in a sepcified range of cells. having trouble with if the heading isn't found which sometimes happens as the data is downloaded from brandwatch and if nothing returns for that particular subject in Brandwatch then the heading isn't in the downloaded data file. I want the macro to stop when the required text isn't found in the range.
I am only just learning VB and have no idea how to stop the next sub from running if the specific text isnt found. As it stands at the minute it is putting in another heading as the next subroutine is a copy active column and then goto another specific column and paste.
The message 'The Value you are searching for is not available' comes up but then the next sub pastes the wrong heading in when I just want all the macros to stop at that point.
Any help would be greatly appreciated.
Thanks Sylly
the offending Subroutine is below
Sub FIND_POTENTIAL_IRRELEVANT_MENTIONS()
'============================
'FIND POTENTIAL_IRRELEVANT_MENTIONS
'============================
Dim MyValue As Variant
On Error Resume Next
Range("CT9:HD9").Find(What:="Market Insight Report").Select
On Error GoTo 0
MyValue = ActiveCell.Value
If MyValue = "" Then
MsgBox "The Value you are searching for is not available"
Else
MsgBox MyValue & " found in " & ActiveCell.Address
End If
End Sub
Related
I am trying to automatically change the filtered range in a multiple pivot tables to a desired four week range at the same time instead of having to manually filter them all.
The Weeks are defined by week numbers 1-52 and not as dates. I have been unable to get any version of code to work on an individual pivot table and have not attempted to write the VBA to affect multiple tables at once.
Example of pivot table and 4 week range set up
Here is the last attempt. It resulted in
Run-time error '1004': Application-defined or object-defined error
highlighting the last line of code.
Sub Updateweekrange1()
If Range("T2").Value = "" Then
MsgBox ("You Must First Enter a Beginning Week#.")
Exit Sub
End If
If Range("V2").Value = "" Then
MsgBox ("You Must First Enter a Ending Week#.")
Exit Sub
End If
With ActiveSheet.PivotTables("Test2").PivotFields("Week")
.ClearAllFilters
.PivotFilters.Add Type:=xlValueIsBetween, DataField:=ActiveSheet.PivotTables("Test2").PivotFields("Week"), Value1:=Range("T2").Value, Value2:=Range("V2").Value
End With
End Sub
I tested the below and it worked for me.
I solved this by recording a macro (via the initially hidden developer tab), whilst I set a between filter on the Week column and then examined the generated code.
Setting wsPivot to ActiveSheet or perhaps Sheets("Sheet1") for example can allow a bit more flexibility in our coding. I'm autistic; so I can sometimes appear to be schooling others, when I'm only trying to help.
Option Explicit
Private Sub Updateweekrange1()
Dim wsPivot As Worksheet
Set wsPivot = ActiveSheet
If wsPivot.Range("T2").Value = "" Then
MsgBox ("You Must First Enter a Beginning Week#.")
Exit Sub
End If
If wsPivot.Range("V2").Value = "" Then
MsgBox ("You Must First Enter a Ending Week#.")
Exit Sub
End If
With wsPivot.PivotTables("Test2").PivotFields("Week")
.ClearAllFilters
.PivotFilters.Add2 _
Type:=xlValueIsBetween, DataField:=wsPivot.PivotTables("Test2"). _
PivotFields("Sum of Cost"), Value1:=wsPivot.Range("T2").Value, Value2:=wsPivot.Range("V2").Value
End With
End Sub
I have looked up the question and have seen several solutions addressing things like Select or having protected worksheets, none of which apply to me here.
For various reasons, I can't post the entire code, but I will give a description of what it does and post the exact sub that is giving me issues.
I have a Macro that generates a number of worksheets based on the Month and Year input by the user (so "1" - "31" or "1" - "30" etc). To generate these worksheets, the macro makes copies of a worksheet fittingly named "EXAMPLE". One thing that is copied is a picture (just a rectangle with the word 'Export' on it) that has a macro attached to it.
I recently made what I thought was a cosmetic change by moving the location of this picture, since then, when I run the macro I get an error:
"Run-time error '1004':
Microsoft Excel cannot paste the data."
And options for 'End' 'Debug' and 'Help'
If I select 'Debug' it points me to a second macro which is called during the process of the generation macro'
Sub CopyAllShapes()
Dim ws As Worksheet
' Sets the non-generated worksheets as an array
nSheets = Array("EXAMPLE", "Weekly Totals", "Menu")
' Copies the Picture from the EXAMPLE sheet to all worksheets not in the array and then assigns a
' seperate Macro called "Export" to the picture on each of these sheets.
For Each ws In ActiveWorkbook.Worksheets
If Not IsNumeric(Application.Match(ws.Name, nSheets,0)) Then
Sheets("EXAMPLE").Shapes("Picture 1").Copy
ws.Range("J62").PasteSpecial
ws.Shapes("Picture 1").OnAction = "Export"
End If
Next ws
Application.CutCopyMode = xlCopy
End Sub
The Debug option highlights the line
ws.Range("J62").PasteSpecial
What really confuses me is that if I select 'End' instead of 'Debug', the macro stops, but all the the sheets have had the picture pasted as well as the Export Macro assigned and everything works as expected. If I were the only person using this, it would be a minor annoyance, but this document is used by many people that can't reliable be told to "just ignore" the error. Since the macro is functioning as expected, how can i troubleshoot what is causing the problem and make the error go away?
As I said, I can't post the entire macro, but I can post some bits and pieces if anyone needs more info.
Not a pure fix, but this code will retry the Copy/Paste if it fails (up to 3 times), instead of just dropping it:
Const MaxRetries AS Long = 3
Sub CopyAllShapes()
Dim ws As Worksheet
Dim TimesRetried As Long
' Sets the non-generated worksheets as an array
nSheets = Array("EXAMPLE", "Weekly Totals", "Menu")
' Copies the Picture from the EXAMPLE sheet to all worksheets not in the array and then assigns a
' seperate Macro called "Export" to the picture on each of these sheets.
For Each ws In ActiveWorkbook.Worksheets
If Not IsNumeric(Application.Match(ws.Name, nSheets,0)) Then
TimesRetried = 0
CopyExampleShape:
On Error Resume Next
Sheets("EXAMPLE").Shapes("Picture 1").Copy
ws.Range("J62").PasteSpecial
'If the Copy/Paste fails, retry
If Err Then
On Error GoTo -1 'Clear the Error
'Don't get stuck in an infinite loop
If TimesRetried < MaxRetries Then
'Retry the Copy/paste
TimesRetried = TimesRetried + 1
DoEvents
GoTo CopyExampleShape
End If
End If
On Error GoTo 0
ws.Shapes("Picture 1").OnAction = "Export"
End If
Next ws
Application.CutCopyMode = xlCopy
End Sub
I have come across a similar issue before, and it was been down to another program (in one case Skype) reacting to data being added to the Clipboard by "inspecting" it. That then briefly locked the clipboard, so the Paste/PasteSpecial operation failed. This then caused the Clipboard to be wiped clean... All without Excel doing anything wrong.
"It is possible to commit no mistakes and still lose. That is not a weakness; that is life." ~ Jean-Luc Picard
On moving to Office 365 and Win10 (can't say which of those was the culprit) I found a bunch of existing macros which would give that same error when trying to paste a copied image onto a worksheet.
When entering debug, the "paste" line would be highlighted, but if I hit "Continue" it would (after one or two attempts) run with no errors.
I ended up doing this:
'paste problem fix
Sub PastePicRetry(rng As Range)
Dim i As Long
Do While i < 20
On Error Resume Next
rng.PasteSpecial
If Err.Number <> 0 Then
Debug.Print "Paste failed", i
DoEvents
i = i + 1
Else
Exit Do
End If
On Error GoTo 0
i = i + 1
Loop
End Sub
...which looks like overkill but was the only reliable fix for the problem.
EDIT: cleaned up and refactored into a standalone sub.
Just wanted to let everyone know I have found a (sort of) solution. Based on the answers/comments from Tim Williams and PeterT I modified the code to look like this:
Sub CopyAllShapes()
Dim ws As Worksheet
' Sets the non-generated worksheets as an array
nSheets = Array("EXAMPLE", "Weekly Totals", "Menu")
' Copies the Picture from the EXAMPLE sheet to all worksheets not in the array and then assigns a
' seperate Macro called "Export" to the picture on each of these sheets.
For Each ws In ActiveWorkbook.Worksheets
If Not IsNumeric(Application.Match(ws.Name, nSheets,0)) Then
Sheets("EXAMPLE").Shapes("Picture 1").Copy
On Error Resume Next
ws.Range("J62").PasteSpecial
On Error Goto 0
ws.Shapes("Picture 1").OnAction = "Export"
End If
Next ws
Application.CutCopyMode = xlCopy
End Sub
This has successfully ignored the error and everything is working properly now! Thanks everyone for your help, hopefully this aids someone else in the future!
I have looked at some examples for my question but couldn't find an answer that works.
Background:
I have a list of items (let's say apple, orange, banana) in Sheet1 (A2:A77, which is already a defined range with the name "Liste").
I then have on another sheet (Let's say Sheet2) with several cells where a userform (created with vba code) pops up where the user can choose an item and click OK.
However, due to the nature of the userform (and the list), you can have spelling errors etc and it will still be accepted. So I would like to create a check where it matches the input to the given list (to prevent users from putting anything else in). The userform/code is on purpose to keep it searchable (rather than just a simple data validation list).
Issue:
I tried to create this with vba code that checks the input, matches it to the Sheet1 list and if there is no match, shows a msgbox with a statement. This partially worked (for some letters but not others, very strange).
Here is the code I had:
Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim rSearchRng As Range
Dim vFindvar As Variant
If Not Intersect([B7:B26], Target) Is Nothing Then
Set rSearchRng = Sheet4.Range("Liste")
Set vFindvar = rSearchRng.Find(Target.Value)
If Not vFindvar Is Nothing Then
MsgBox "The Audit Project Name you have entered is not valid. Please try again!", vbExclamation, "Error!"
Selection.ClearContents
End If
End If
Application.EnableEvents = True
End Sub
So I was thinking of creating this error message instead with a simple data validation.
Data validation
I have tried the "list" option (and put it equal to the named range) but that did nothing (no error box showed up)
I have tried "Custom" with the following formula 'SUMPRODUCT(--(B12=Liste)>0)=TRUE (I found this on a post which worked for others when I tried it in the cell it gave me the expected "TRUE/FALSE" results) but still nothing shows up
UPDATE
Tigeravatars data validation recommendations work if you don't have a userform (see comments below).
For it to work with a UserForm, I changed the 'MatchEntry' to TRUE and also deleted any unwanted "change events" from my ComboBox code. The final code I use now is below:
Dim a()
Private Sub CommandButton2_Click()
End Sub
Private Sub UserForm_Initialize()
a = [Liste].Value
Me.ComboBox1.List = a
End Sub
Private Sub ComboBox1_Change()
Set d1 = CreateObject("Scripting.Dictionary")
tmp = UCase(Me.ComboBox1) & "*"
For Each c In a
If UCase(c) Like tmp Then d1(c) = ""
Next c
Me.ComboBox1.List = d1.keys
Me.ComboBox1.DropDown
End Sub
Private Sub CommandButton1_Click()
ActiveCell = Me.ComboBox1
Unload Me
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
I thought I show it here in case anyone stumbles across my question.
Thank you!
Select your cells where you want to put the data validation
With the cells selected, go to Data Tab -> Validation
Set "Allow" to "List" and set the Source to =Liste as shown here:
Next go to the "Error Alert" tab and set "Style" to "Warning" and enter the desired text in "Title" and "Error Message" as shown here:
Test it out. You should now have a drop-down list of valid choices, and if you attempt to manually enter an invalid choice you'll get the error message you specified.
As a note, if you want the data validation to completely disallow/prevent any entry not in the list, you'll need to set the Error Allert -> Style to be "Stop" instead of "Warning".
EDIT:
Per comments, it can't be a drop-down list. I highly recommend using a drop-down list for this because it will be the most effective way to cut down on time entering data as well as reduce errors from typos. However, if it absolutely cannot be a drop-down list, then you can use a Custom Data Validation and set the formula to =ISNUMBER(MATCH(B7,Liste,0)) (we are using B7 here because it is the first cell in the range of cells that contains this data validation).
Try the following formula:
=NOT(ISERROR(FIND("-"&A1&"-",(TEXTJOIN(,"-",TRUE,Sheet1!A1:A77)))))
That combines all the texts and then see if what's in the cell occurs in the list. I put it between dashes to prevent it from accepting partials.
I'm currently developing an add-in for Excel which will automatically format a table. The users has to follow the specific format when preparing the table, or else the common error of "Merging cells only keeps the upper-left cell value, and discards the other values." is bound to appear.
I would like to mute this alert from Excel, but would still like to catch this error and pass a different message to the users to terminate this sub. I've tried this:
Sub FormatTable()
On Error Goto ErrHandler
Application.DisplayAlerts = False
'Codes for formatting the table
Exit Sub
ErrHandler:
MsgBox "Incorrect formatting. Terminating process to conserve data."
End Sub
However, I do realise that using "Application.DisplayAlerts = False" will cause Excel to choose the default action and proceed to merge the cells which causes a big mess. It will not go the ErrHandler. Is there some way for making this happen? Thank you.
You could test for merged cells in the selected range prior to running your code:
Public Function HasMergedCells(oRng As Range)
Dim oCell As Range
Dim oArea As Range
For Each oArea In oRng.Areas
For Each oCell In oArea.Cells
If oCell.MergeArea.MergeCells Then
HasMergedCells = True
Exit Function
End If
Next
Next
End Function
i have an excel with 75 columns and some thousands of rows of data. Out of 75 columns I am using 5 columns for my vba coding purpose. These 5 columns hold flags (either 0 or 1) based on which I am locking the cells in the corresponding row (Flags are coming from Database). As user doesn't want these flag columns I just hid those columns but when ever user tries to copy data from my workbook to another workbook user is able to copy the hidden columns which client doesn't want.
So is there anyway to restrict them not to copy the hidden columns through VBA or with any setting? Actually for this issue what I thought is like on key press of Ctrl + C, I tried to change the Selection.Copy as Selection.Range.SpecialCells(xlCellTypeVisible). But I am getting some error like wrong number of arguments or invalid property assignment.
The lines of code is
Private Sub Workbook_Open()
Application.OnKey "^c", "Copy"
End Sub
Sub Copy()
If Selection Is Nothing Then
Else
Selection.Copy = Selection.Range.SpecialCells(xlCellTypeVisible)
End If
End Sub
Any ideas to restrict users not to copy the hidden columns. Any help would be appreciated greatly.
Try this
Sub Copy()
Dim rng As Range
On Error GoTo Whoa
If Not Selection Is Nothing Then
Set rng = Selection.Cells.SpecialCells(xlCellTypeVisible)
rng.Copy
End If
LetsContinue:
Exit Sub
Whoa:
MsgBox Err.Description, vbCritical, "Error Number : " & Err.Number
Resume LetsContinue
End Sub
Note: I have used Error Handling which is a must because the user might select non contiguous ranges and the code will break if the error handling is not done :) See Screenshot below