This is my first post on here and I have very little formal training in coding, so this is probably a very easy problem.
I'm running into an error 9, VBA Subscript out of range, when running macros defined by the code below.
Specifically, it is the Sub Select_Last() function. Excel does not like the subsequent expression, however if this is used on its own in a separate Excel file then it works fine.
I think the problem is that Excel's default variable (Activesheet etc) are conflicting with each other. But I am not sure how to remedy this. The other subs work fine. Can anyone help? Thank you.
Public lastsheet As String
Sub Select_Last()
Sheets(lastsheet).Select
End Sub
Sub Protect()
For i = 1 To Sheets.Count
Sheets(i).Protect
Next i
End Sub
Sub UnProtect()
For i = 1 To Sheets.Count
Sheets(i).UnProtect
Next i
End Sub
Sub SelectUnlockedCells()
Dim WorkRng As Range
Dim OutRng As Range
Dim Rng As Range
On Error Resume Next
Set WorkRng = Application.ActiveSheet.UsedRange
Application.ScreenUpdating = False
For Each Rng In WorkRng
If Rng.Locked = False Then
If OutRng.Count = 0 Then
Set OutRng = Rng
Else
Set OutRng = Union(OutRng, Rng)
End If
End If
Next
If OutRng.Count > 0 Then OutRng.Select
Application.ScreenUpdating = True
End Sub
The other functions work OK.
Consider:
Public lastsheet As String
Sub Select_Last()
lastsheet = Sheets(Sheets.Count).Name
Sheets(lastsheet).Select
End Sub
The key issue is to assign a value to a variable before using it.
Related
Please can someone help me out, I seem to be going around in circles with my problem?
I have a workbook with 4 worksheets Comparison, Office1, Office2 and Office3. On the Comparison sheet the other sheet names are listed in column A. In column B on this sheet I have a button.
What I want to do is double click the button (I have sorted the code for this) and this will then take you to cell D5 on the corresponding sheet.
At the moment I have the following code but it doesn't seem to activate the Office sheet it uses the comparison sheet.
Could anyone please let me know what I am missing?
Thanks
Sub OfficeSht()
Dim rCrit3 As Range
Dim wb As Workbook
Dim ws As Worksheet
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set rCrit3 = ActiveCell.Offset(RowOffset:=0, ColumnOffset:=-2)
Debug.Print rCrit3
Set ws = rCrit3.Worksheet
ws.Activate
ActiveSheet.Range("D5").Select
Application.EnableEvents = True
End Sub
Application.Goto seems appropriate and reduces the steps to achieve your goal.
Sub OfficeSht()
Dim ws As string
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
ws = ActiveCell.Offset(RowOffset:=0, ColumnOffset:=-2).value2
Debug.Print "'" & ws & "'!D5"
Application.Goto Reference:="'" & ws & "'!R5C4" '<~~ D5 in xlR1C1
With Application
.EnableEvents = true
.ScreenUpdating = true
End With
End Sub
You may want make this a Worksheet_BeforeDoubleClick event.
You don't say what kind of button you have so I've give a couple of examples.
One piece of code that is common in all examples is WorkSheetExists which checks if the sheet name corresponds to a worksheet.
Public Function WorkSheetExists(SheetName As String) As Boolean
Dim wrkSht As Worksheet
On Error Resume Next
Set wrkSht = Worksheets(SheetName)
WorkSheetExists = (Err.Number = 0)
Set wrkSht = Nothing
On Error GoTo 0
End Function
Next are three ways to call the OfficeSht procedure.
If your buttons are ActiveX button and are in column B you can use:
Private Sub CommandButton1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
OfficeSht Me.Shapes("CommandButton1").TopLeftCell
End Sub
This code returns a reference to Top Left Cell that your button sits in - assuming your sheet name is one cell to the left of this.
The second way is if you're using a Form button.
Public Sub Button_Click()
OfficeSht Me.Shapes(Application.Caller).TopLeftCell
End Sub
Again, it returns a reference to the Top Left Cell that the button is placed in. When you add the button just assign it to the Button_Click procedure.
The third way assumes your button is actually a cell formatted to look like a button, or if you just want to double-click the sheet name in column A and do away with having a button in column B:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
OfficeSht Target
End Sub
Finally, your code to select cell D5 (Row 5, Column 4 - R5C4).
If you're clicking, or referenced cell is in, column B:
Public Sub OfficeSht(ByVal Target As Range)
Dim rLastCell As Range
Dim rDataRange As Range
Set rLastCell = Cells(Rows.Count, 1).End(xlUp)
Set rDataRange = Range("A1", rLastCell)
If Not Intersect(Target, rDataRange.Offset(, 1)) Is Nothing Then
If WorkSheetExists(Target.Offset(, -1).Value) Then
Application.Goto "'" & Target.Offset(, -1).Value & "'!R5C4"
End If
End If
End Sub
If you're clicking, or referenced cell is in, column A:
Public Sub OfficeSht(ByVal Target As Range)
Dim rLastCell As Range
Dim rDataRange As Range
Set rLastCell = Cells(Rows.Count, 1).End(xlUp)
Set rDataRange = Range("A1", rLastCell)
If Not Intersect(Target, rDataRange) Is Nothing Then
If WorkSheetExists(Target.Value) Then
Application.Goto "'" & Target.Value & "'!R5C4"
End If
End If
End Sub
Might've waffled on a bit there.... :)
Hi everyone i made a button on excel using VBA modules,The code works on the active sheet but what im looking for is to be applied to more sheets, not just the active sheet where the button is placed.
Sub Botón1_Haga_clic_en()
Call Worksheet_Calculate
End Sub
'apply cells colors from single-cell formula dependencies/links
Private Sub Worksheet_Calculate()
Dim Cel As Range
Dim RefCel As Range
On Error Resume Next
For Each Cel In ActiveSheet.UsedRange
If Cel.HasFormula Then
Set RefCel = Evaluate(Mid(Cel.Formula, 2))
Cel.Interior.Color = RefCel.Interior.Color
End If
Next Cel
End Sub
Try the code below :
Option Explicit
Sub Botón1_Haga_clic_en()
Dim wsName As String
Dim ws As Worksheet
wsName = ActiveSheet.Name
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name Like wsName Then '<-- is worksheet's name doesn't equal the ActiveSheet's
ApplyCellColors ws ' <-- call you Sub, with the worksheet object
End If
Next ws
End Sub
'=======================================================================
'apply cells colors from single-cell formula dependencies/links
Private Sub ApplyCellColors(ws As Worksheet)
Dim Cel As Range
Dim RefCel As Range
On Error Resume Next
For Each Cel In ws.UsedRange
If Cel.HasFormula Then
Set RefCel = Evaluate(Mid(Cel.Formula, 2))
Cel.Interior.Color = RefCel.Interior.Color
End If
Next Cel
End Sub
Your problem can be translated to something like How to loop over all sheets and ignore one of them?
This is a good way to do it:
Option Explicit
Option Private Module
Public Sub TestMe()
Dim wks As Worksheet
For Each wks In ThisWorkbook.Worksheets
If wks.name = "main" Then
Debug.Print "Do nothing here, this is the active sheet's name"
Else
Debug.Print wks.name
End If
Next wks
End Sub
Pretty sure, that you should be able to fit it in your code.
I have a template sheet that I have set up named "Template".
I have a range of cells on another worksheet called "Formulation" that I would like it to look through the range "G7:W7" and create a copy of the "Template" and rename it accordingly.
I have adapted a piece of code I have found but I keep encountering a run time error 13 - type mismatch.
Here is the code:
`Sub CopyInfoSheetandInsert()
'
' CopyInfoSheetandInsert Macro
'
Dim rcell As Range
Dim Background As Worksheet
Set Background = Sheets("Formulation")
For Each rcell In Range("D7:W7")
If rcell.Value <> "" Then
Sheets("Template").Copy Before:=Sheets("COSHH")
Sheets("Template (2)").Name = rcell.Value
End If
Next rcell
End Sub
Any advice would be greatly appreciated!
UPDATE
By moving the macro button to the formulation page the copy function now works however, on the following line of code I now get a subscript out of range error?
Sheets("Template(2)").Name = rcell.Value
Kind Regards,
Aidan
You need something like:
Sub CopyInfoSheetandInsert()
Dim rcell As Range
Dim Background As Worksheet
Set Background = Sheets("Formulation")
For Each rcell In Range("D7:W7")
If rcell.Value <> "" And SheetExists(rcell.Value) = False Then
Sheets("Template").Copy Before:=Sheets("COSHH")
Sheets(Sheets("COSHH").Index - 1).Name = rcell.Value
End If
Next rcell
End Sub
Function SheetExists(SheetName) As Boolean
Dim sht As Worksheet
'Assume Failure
SheetExists = False
For Each sht In ActiveWorkbook.Sheets
If sht.Name = SheetName Then
'Success
SheetExists = True
Exit Function
End If
Next sht
End Function
I have a stylized spreadsheet with formatted cells for users to input data. I am trying to create a macro for use with a button to clear all of the input cells at once. However, I am struggling with the "find" and "findformat" functions.
To make it simple, in this code I am just looking for cells that say "Retail". When I run the code, the value of myRange is always Nothing even though there is clearly a cell in the spreadsheet that has the value "Retail". Any ideas why the range is Nothing?
Public Sub reset()
'reset all input fields to no value
msg = MsgBox("Are you sure you want to delete all data and reset all files to original state?", vbYesNoCancel, "***Warning***")
If msg = vbYes Then
Dim inputCell As Long
Dim noteCell As Long
inputCell = RGB(255, 204, 153)
noteCell = RGB(255, 255, 204)
Dim myRange As Range
Dim mySheet As Worksheet
Dim shp As Shape
Dim sht As Worksheet
Dim objXL As Object
Dim wb As Workbook
Dim pathName, name, myLink As String
Set sht = ActiveSheet
Set wb = ActiveWorkbook
pathName = wb.FullName
name = wb.name
For Each shp In sht.Shapes
If shp.Type = msoGroup Then
For i = 1 To shp.GroupItems.Count
If shp.GroupItems(i).Type = msoEmbeddedOLEObject Then
shp.GroupItems(i).Select
shp.GroupItems(i).OLEFormat.Activate
Set wb = ActiveWorkbook
If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then
For Each link In wb.LinkSources(xlExcelLinks)
On Error Resume Next
wb.ChangeLink name:=link, newName:=pathName, Type:=xlLinkTypeExcelLinks
Next link
End If
For Each mySheet In ActiveWorkbook.Worksheets
With Application.FindFormat.Interior.Color = inputCell
myRange = mySheet.Cells.Find(what:="Retail") ', searchformat:=True)
myRange.ClearContents
End With
Next mySheet
wb.Close (False)
End If
Next i
End If
Next shp
End If
End Sub
I refer to the FindFormat documentation for some example:
https://msdn.microsoft.com/en-us/library/office/ff838023.aspx
And modify your code thusly:
With Application.FindFormat
.Interior.Color = inputCell
Do
Set myRange = mySheet.Cells.Find(what:="Retail", SearchFormat:=True)
If myRange Is Nothing Then myRange.ClearContents
Loop While Not myRange Is Nothing
End With
NOTE: You should be using the Set keyword when assigning to a range object myRange. Also, your improper use of On Error Resume Next may be masking additional errors which are adversely impacting the results of this function. You can rectify the latter issue like so:
If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then
For Each link In wb.LinkSources(xlExcelLinks)
On Error Resume Next
wb.ChangeLink name:=link, newName:=pathName, Type:=xlLinkTypeExcelLinks
On Error GoTo 0 '### RESUME NORMAL ERROR HANDLING
Next link
End If
I changed my code as follows and now it works exactly as I wanted:
For Each mySheet In ActiveWorkbook.Worksheets
With Application.FindFormat
.Interior.Color = inputCell
Do
On Error GoTo handler:
Set myRange = mySheet.Cells.Find(what:="?*", searchformat:=True).MergeArea
If Not (myRange Is Nothing) Then
myRange.ClearContents
End If
Loop While Not (myRange Is Nothing)
.Interior.Color = noteCell
Do
On Error GoTo handler:
Set myRange = mySheet.Cells.Find(what:="?*", searchformat:=True).MergeArea
If Not (myRange Is Nothing) Then
myRange.ClearContents
End If
Loop While Not (myRange Is Nothing)
handler:
Set myRange = Nothing
Resume Next
End With
Next mySheet
I'm just not sure if this kind of error handling is the best way to deal with the problem, and I don't understand why an error occurs in the first place. So if anyone has a thought on this, I would appreciate it. If not, I'm just happy it works now.
I'm looking for a way to, instead of typing "ActiveCell.OffSet(1,1) over and over again in my vba code, define that as a variable, "x" and use that instead.
I have to use the dim command to do this but I"m not sure what the data type would be.
Suggestions?
When I test it using the code below I get Runtime Error 1004.
Private Sub CommandButton1_Click()
Dim i As Range
Set i = ActiveCell
ActiveSheet.Range(ActiveSheet.Range(i), ActiveSheet.Range(i).End(xlUp)).Select
End Sub
In response to your edit
Avoid the use of .Select/Activate and fully qualify your objects. INTERESTING READ
Your code can be written as
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim rng1 As Range, rng2 As Range
'~~> Change as applicable
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
Set rng1 = ws.Range("A10")
Set rng2 = .Range(rng1, rng1.End(xlUp))
With rng2
Debug.Print .Address
'
'~~> Do something with the range
'
End With
End With
End Sub
If you still want to know what was wrong with your code then see this.
You have already defined your range. You do not need to add ActiveSheet.Range() again. Your code can be written as
Private Sub CommandButton1_Click()
Dim i As Range
Set i = ActiveCell
ActiveSheet.Range(i, i.End(xlUp)).Select
End Sub
EDIT
Followup from comments
Was ActiveSheet.Range() actually problematic or just redundant? – user3033634 14 mins ago
It is problematic. The default property of a range object is .Value
Consider this example which will explain what went wrong with your code
Sub Sample()
Dim ws As Worksheet
Dim rng As Range
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
Set rng = .Range("A1")
rng.Value = "Blah"
MsgBox rng '<~~ This will give you "Blah"
MsgBox rng.Value '<~~ This will give you "Blah"
MsgBox rng.Address '<~~ This will give you "$A$1"
MsgBox ws.Range(rng) '<~~ This will give you an error
'~~> Why? Becuase the above is evaluated to
'MsgBox ws.Range("Blah")
MsgBox ws.Range(rng.Address) '<~~ This will give you "Blah"
End With
End Sub
Dim x As Range
Set x = ActiveCell.OffSet(1,1)
EDIT: in response to your comment:
Private Sub CommandButton1_Click()
Dim i As Range
Set i = ActiveCell
ActiveSheet.Range(i, i.End(xlUp)).Select
End Sub