Please consider the following "code":
Sub MySub()
Dim MySheet As Worksheet
Set MySheet = ActiveSheet
MySheet.DeleteAllRedWords 'This is a Sub
MsgBox MySheet.NumberOfChangesThisWeek 'This is a function
MySheet.ActiveOwner = "Sam" 'This is a property
End Sub
Is this possible? Would class modules do the trick? I tried the code below, but I got an error 438 (Object doesn't support this property or method). Is it possible somehow?
'CLASS MODULE CODE: MyWorkingSheet Class
Private Sub class_initialize()
Me = ActiveSheet
End Sub
'NORMAL MODULE CODE
Sub MySub()
Dim MyTodaySheet As MyWorkingSheet
Set MyTodaySheet = New MyWorkingSheet
End Sub
Sub MySub()
Dim MySheet As New MyWorkingSheet
Set MySheet.Sheet = ActiveSheet
MySheet.DeleteAllRedWords
'etc
End Sub
Class:
'CLASS MODULE CODE: MyWorkingSheet Class
Private m_sht As WorkSheet
'set a reference to the worksheet you want to "wrap" with your class
Property Set Sheet(sht As WorkSheet)
Set m_sht = sht
End Property
Sub DeleteAllRedWords()
'in all your class methods reference m_sht
With m_sht.UsedRange
'code to delete all red words
End With
End Sub
'other methods/functions
Related
This is my code:-
Public CBR As Range
Private Sub ComboBox1_Change()
Dim cbvalue As String
Set CBR = Range("b1")
Call Copy_header
End Sub
Sub Copy_header()
Workbooks("Book2").Worksheets("DropDown").Activate
ActiveSheet.Range.CBR.Select
End Sub
CBR is come as "DOS" or "NDC
I tried to put CBR as range in module also but not working
Obviously I don't know what you are doing, but this may help:
(Indented and spaced)
Option Explicit
Public CBR As String
Private Sub ComboBox1_Change()
Dim cbvalue As String
CBR = "b1"
Call Copy_header
End Sub
Sub Copy_header()
Workbooks("Book2").Worksheets("DropDown").Activate
ActiveSheet.Range(CBR).Select
End Sub
EDIT: This is closer to what you have:
Public CBR As Range
Private Sub ComboBox1_Change()
Dim cbvalue As String
Set CBR = Workbooks("Book2").Worksheets("DropDown").Range("b1")
Call Copy_header
End Sub
Sub Copy_header()
' Workbooks("Book2").Worksheets("DropDown").Activate
' ActiveSheet.Range.CBR.Select
CBR.Worksheet.Activate
CBR.Select
End Sub
EDIT 2: A lot of people don't know this: (Meaning I didn't know this)
That the range includes the workbook and the worksheet!
Option Explicit
Sub sub1()
Dim range1 As Range, range2 As Range
ThisWorkbook.Activate
Sheets("sheet1").Activate
Set range1 = Range("a1")
Set range2 = Workbooks("book2").Sheets("sheet2").Range("b2")
Debug.Print "Range1: ", range1.Worksheet.Parent.Name, range1.Worksheet.Name, range1.Address
Debug.Print "Range2: ", range2.Worksheet.Parent.Name, range2.Worksheet.Name, range2.Address
End Sub
I have the following sub routine (in module10).
Sub varWorksheet(wksht As String)
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(wksht)
Set ws = Nothing
End Sub
I want to be able to pass this sub routine as a reference to a variable with something like this rather than have to declare it explicitly in each routine:
Set ws = module10.varWorksheet("Sheet1")
I'm getting a compilation error -> expected Function or Variable.
You shoud use a function like this.
Function varWorksheet(wksht As String) As Worksheet
On Error Resume Next
Set varWorksheet = ThisWorkbook.Sheets(wksht)
End Function
It will return nothing if the worksheet doesn't exist. This works fine.
Sub Test()
Dim ws As Worksheet
Set ws = Modul10.varWorksheet("Tabelle4")
If ws Is Nothing Then
Debug.Print "No worksheet"
Else
' what ever you want
End If
End Sub
I have created a little macro to return the number of unique values and display it in the status bar of Excel when a range is selected. This works fine at the document level. However the SelectionChange event is not launching when I attempt to run it at the application level. The following is what I have.
Class Module 'ExcelEventCapture'
Option Explicit
Public WithEvents ExcelApp As Application
Private Sub ExcelApp_SelectionChange(ByVal Target As Range)
If TypeName(Target) = "Range" Then
Application.StatusBar = "Unique Count: " & CountUnique(Target)
End If
End Sub
Private Function CountUnique(rng As Range) As Long
Dim dict As Dictionary
Dim cell As Range
Set dict = New Dictionary
For Each cell In rng.Cells
If cell.Value2 <> 0 Then
If Not dict.Exists(cell.Value) Then
dict.Add cell.Value, 0
End If
End If
Next
CountUnique = dict.Count
End Function
ThisWorkbook
Option Explicit
Dim myobject As New ExcelEventCapture
Sub Workbook_Open()
Set myobject.ExcelApp = Application
End Sub
What am I missing? Thanks
SelectionChange event does not exist in Application class.
You can use SheetSelectionChange event and there is no need to check Target class name.
Private Sub ExcelApp_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.StatusBar = "Unique Count: " & CountUnique(Target)
End Sub
I'm running excel 2010 and have developed a xlsm to roll out to a few users
I have protected the workbook with the following routine which works well
My problem is I have used listobjects in the workbook as mapping tables which require intervention by the users. The existing listobject rows can be manipulated but no new rows can be added - Any ideas on how I can get around this ?
thanks
Public Sub ProtectAll(ByVal wbWorkbook As Workbook)
Dim wks As Worksheet
For Each wks In wbWorkbook.Worksheets
wks.Protect sPasswordToLock, True, True, False, True, True,True, True, False, False, False, False, False, True, True, True
wks.EnableSelection = xlNoRestrictions
Next wks
It is possible to do this though the answer is more complicated than you maybe expect. Jon van der Heyden used to have a good article about this on his site (exceldesignsolutions.com) but I think he has removed it. I adopted some of his code that will allow you to add rows to a listobject on a protected sheet. The nice thing about this is that it forces the user to only enter data in the row immediately below the listobject, which ensure that the listobject "grows" to include the new data.
In a nutshell, the method used is to create a custom class that will contain a listobject and an event handler that listens for a change to the sheet containing it. If the change is in the row immediately below the listobject then undo the change, unprotect the sheet, redo the change and reprotect the sheet. In addition unlock the row immediately below the listobject.
Here is what to do:
In your workbook containing the listobjects, create a custom class module and name it cProtectedLO. Paste the following code into it:
Option Explicit
Private m_loTable As ListObject
Private m_strPassWord As String
Private WithEvents m_appExcel As Excel.Application
Public Property Set Table(ByVal loTable As ListObject)
Set m_loTable = loTable
End Property
Public Property Let Password(ByVal strPassword As String)
m_strPassWord = strPassword
End Property
Private Sub Class_Initialize()
Set m_appExcel = Excel.Application
End Sub
Private Sub m_appExcel_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rngTable As Excel.Range
Dim varValue As Variant
Set rngTable = m_loTable.Range
If Sh Is rngTable.Parent Then
If Not Intersect(Target.Offset(-1), rngTable) Is Nothing Then
If Intersect(Target, rngTable) Is Nothing Then
varValue = Target.Value
Sh.Unprotect Password:=IIf(Len(m_strPassWord), m_strPassWord, Null)
With Application
.EnableEvents = False
.Undo
Target.Value = varValue
Sh.Cells.Locked = True
m_loTable.DataBodyRange.Locked = False
m_loTable.Range(m_loTable.Range.Rows.Count, 1).Offset(1, 0).Resize(1, m_loTable.ListColumns.Count).Locked = False
.EnableEvents = True
End With
Sh.Protect Password:=IIf(Len(m_strPassWord), m_strPassWord, Null)
Target.Offset(1).Select
End If
End If
End If
End Sub
Private Sub Class_Terminate()
Set m_loTable = Nothing
Set m_appExcel = Nothing
End Sub
Add a normal code module and paste this code in it:
Option Explicit
Public m_colProtectedLO As Collection
Public Sub EnableProtectedTables(Optional ByVal pw As Variant)
Dim clsProtectedLO As cProtectedLO
Dim wks As Worksheet, lo As ListObject
Set m_colProtectedLO = New Collection
For Each wks In ThisWorkbook.Worksheets
For Each lo In wks.ListObjects
Set clsProtectedLO = New cProtectedLO
With clsProtectedLO
Set .Table = lo
If Not IsMissing(pw) Then
.Password = pw
End If
End With
wks.Unprotect Password:=pw
lo.DataBodyRange.Locked = False
lo.Range(lo.Range.Rows.Count, 1).Offset(1, 0).Resize(1, lo.ListColumns.Count).Locked = False
wks.Protect Password:=pw
m_colProtectedLO.Add Item:=clsProtectedLO
Next lo
Next wks
End Sub
In the ThisWorkbook module, paste the following:
Option Explicit
Private Sub Workbook_Open()
EnableProtectedTables
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set m_colProtectedLO = Nothing
End Sub
Note that is the sheets are password protected you would have to include it as a value for the "pw" argument in the call to EnableProtectedTables, like this:
EnableProtectedTables pw:="YourPasswordHere"
Save the workbook, close it and open it again and you should be all set.
I have a sub that goes through each worksheet and checks for a flag.
If the flag is raised, I want it to run another sub. The flag checking works, but the other sub which is called runs on the main sheet.
Code:
Sub update()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If (ws.Cells(1, 5) = 1) Then
Call update2(ws)
End If
Next
End Sub
Sub update2(ws As Worksheet)
ws.clear <----does not work
End Sub
sub dothis()
cells(1,6) = "hallo"
end sub
how do I get this to work?
You need to either use a public variable (generally not recommended) or send the necessary arguments to the procedure(s) where they are needed.
Sub update2(ws As Worksheet)
Call dothis(ws)
End Sub
sub dothis(ws as Worksheet)
ws.cells(1,6) = "hallo"
end sub
Sub update2(ws As Worksheet)
ws.Cells.Clear
End Sub