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
Related
I'm trying to make a Spin Button that will edit the active cell, but only when it is within a specific cell range. I want the code to start up if the active cell is within the range of Sheet 1 cells J63:J97 and, not run if it is outside that range.
This is the code I have so far. It will edit the active cell, as needed. However, it is not limited to the range I need it to be.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
SpinButton1.Value = Selection.Value
End Sub
Private Sub SpinButton1_Change()
Selection.Value = SpinButton1.Value
End Sub
Try using Application.Intersect.
I have defined a separate Function to do the job.
This code is tested and it works:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If checkIntersection(Target, Range("J63:J97")) Then
SpinButton1.Value = Selection.Value
End If
End Sub
Private Sub SpinButton1_Change()
If checkIntersection(Selection, Range("J63:J97")) Then
Selection.Value = SpinButton1.Value
End If
End Sub
'Check if Range1 and Range2 are intersecting
Function checkIntersection(range1 As Range, range2 As Range) As Boolean
checkIntersection = Not Application.Intersect(range1, range2) Is Nothing
End Function
may check selection with Intersect
Private Sub SpinButton1_Change()
If Not Intersect(Selection, Range("J63:J97")) Is Nothing Then
Selection.Value = SpinButton1.Value
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("J63:J97")) Is Nothing Then
SpinButton1.Value = Selection.Value
End If
End Sub
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
Sub my_code_sht1()
Sheets("Sht1").select
'------------------
'------MY CODE-----
'------------------
End sub
Sub my_code_sht2()
Sheets("Sht2").select
'------------------
'------MY CODE-----
'------------------
End sub
"MY CODE" is exactly the same for my 2 sub.
Now I'd like to know if it's possible to regroup these two pieces of code like this:
Sub my_code()
For string = "Sht1" to "Sht2"
Sheets("string").select
'------------------
'------MY CODE-----
'------------------
Next string
End sub
Is something like that possible? Thanks in advance
Here is one way, not that you need to select each sheet
Sub my_code()
Dim ws As Worksheet
For Each ws In Sheets(Array("Sht1", "Sht2"))
ws.Select
'code
Next ws
End Sub
Alternatively, you code extract your code into its own subroutine and pass the sheet name as a parameter or you could use a ParamArray to pass in a variable number of sheet names.
Sub my_code_sht1()
ProcessWorkSheet "Sht1"
ProcessWorkSheet "Sht2"
ProcessWorkSheetsArray "Sht1", "Sht2"
End Sub
Sub ProcessWorkSheet(SheetName As String)
Sheets(SheetName).Select
'------------------
'------MY CODE-----
'------------------
End Sub
Sub ProcessWorkSheetsArray(ParamArray SheetNames())
Dim vName As Variant
For Each vName In SheetNames
Sheets(vName).Select
'------------------
'------MY CODE-----
'------------------
Next
End Sub
Here is another option with array and for loop. It does not use for each, but it checks the length of the array:
Sub my_code()
dim arr_names as variant
dim l_counter as long
arr_names = Array("Sht1", "Sht2", "Sht3")
for l_counter = lbound(arr_names) to ubound(arr_names)
sheets(arr_names(l_counter)).select
'code
next l_counter
end sub
If you apply the same code, then first `
Sub DoWithSheet(wks As Worksheet)
' Code for the Worksheet
Debug.Print wks.Name
' and more
End Sub
And then for two sheets only
DowithSheet Sheets("Sht1")
DoWithSheet Sheets("Sht2")
Objective : Create a userform and take a user input, and then from user input put it in a list and when you click the list it automatically find it in the whole workbook.
Something Like this:
I saw this post: Match in whole workbook
And I created something out of that:
Public Sub CommandButton3_Click()
Dim TempArray As Variant
Dim RealArray()
TempArray = Application.InputBox("Select a range", "Obtain Range Object", Type:=64)
ArrayRows = UBound(TempArray)
ReDim RealArray(1 To ArrayRows)
For i = 1 To ArrayRows
RealArray(i) = TempArray(i, 1)
Next i
MsgBox "The number if rows selected are " & ArrayRows
ListBox1.List = RealArray
ListBox1 Arraay:=RealArray
End Sub
Public Sub ListBox1_Click(ByRef Arraay() As Variant)
Dim Sh As Worksheet
Dim something As Range
Dim ArrayRows As Long
For Each Sh In ThisWorkbook.Worksheets
With Sh.UsedRange
For i = 1 To ArrayRows
Set something = RealArray.Find(What:=RealArray(i))
If Not something Is Nothing Then
Do Until something Is Nothing
test = something.Value
Set something = .FindNext(something)
Loop
End If
Next i
End With
Set something = Nothing
Next
End Sub
After creating this, I get an error regarding the second sub.
procedure declaration does not match description of event or procedure having the same name
The Listbox click event doesn't take any parameters.
Private Sub ListBox1_Click()
End Sub
If you want to pass an array between sub then you can so it this way
Dim MyArray() As Variant
Public Sub CommandButton3_Click()
'~~> Initialize array
End Sub
Private Sub ListBox1_Click()
'~~> Use array here
'~~> Also put an error check if the array is initialized or not
End Sub
I am in the process of creating a user form in excel that uses several ComboBox'. The first ComboBox lists values from column 1 of a table and the following ComboBox' lists values from the following columns. ComboBox 2 onwards also only lists values depending on the preceding box. All ComboBox' show unique values only.
Here is the current code I am using:
Option Explicit
Private Sub ComboBox1_Change()
Call cValues(ComboBox1.Value, ComboBox2, 2)
End Sub
Private Sub ComboBox2_Change()
Call cValues(ComboBox2.Value, ComboBox3, 3)
End Sub
Private Sub ComboBox3_Change()
Call cValues(ComboBox3.Value, ComboBox4, 4)
End Sub
Private Sub ComboBox4_Change()
Call cValues(ComboBox4.Value, ComboBox5, 5)
End Sub
Private Sub ComboBox5_Change()
Call cValues(ComboBox5.Value, ComboBox6, 6)
End Sub
Private Sub UserForm_Initialize()
Dim Rng As Range
Dim Dn As Range
Dim Dic As Object
With Sheets("Listuni")
Set Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
End With
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
For Each Dn In Rng: Dic(Dn.Value) = Empty: Next
Me.ComboBox1.List = Application.Transpose(Dic.keys)
End Sub
Sub cValues(txt As String, Obj As Object, col As Integer)
Dim Dn As Range
Dim Rng As Range
Dim Dic As Object
With Sheets("Listuni")
Set Rng = .Range(.Cells(2, col), .Cells(Rows.Count, col).End(xlUp))
End With
Set Dic = CreateObject("Scripting.Dictionary")
Dic.CompareMode = 1
For Each Dn In Rng
If Dn.Offset(, -1).Value = txt Then
If Not Dic.exists(Dn.Value) Then
Dic(Dn.Value) = Empty
End If
End If
Next Dn
Obj.List = Application.Transpose(Dic.keys)
End Sub
The problem I am having occurs when a user makes a reselection of a preceding ComboBox. Instead of clearing the subsequent boxes, all existing selections remain.
I am looking for a way to clear/default the values of subsequent ComboBox every time a reselection of a preceding ComboBox is made. For example if I make a selection in ComboBox 1 and 2 but then change my selection at ComboBox 1, I want ComboBox 2 to clear rather than show my previous selection. Note that the default position for the user form on launch shows no values in any ComboBox.
I have tried using the .clear method on change however this always gets hung up at:
Obj.List = Application.Transpose(Dic.keys)
I suspect this is because a clear is technically a change and therefore it cannot transpose the list of values to other boxes based on a null value.
This clears all subsequent ComboBoxes - if Combo1 changes, Combo2, 3, 4, 5, and 6 are cleared
Option Explicit
Private ws As Worksheet
Private d As Object
Private Sub UserForm_Initialize()
Dim cel As Range, txt As String, rng As Range
Set ws = Worksheets("Listuni")
Set d = CreateObject("Scripting.Dictionary"): d.CompareMode = vbTextCompare
Set rng = ws.Range(ws.Cells(2, 1), ws.Cells(ws.Rows.Count, 1).End(xlUp))
For Each cel In rng: d(cel.Value) = Empty: Next
ComboBox1.List = Application.Transpose(d.keys)
End Sub
Private Function setList(ByVal txt As String, ByRef cmb As ComboBox) As Object
Dim xID As Long, rng As Range, cel As Range, x As Control
xID = Right(cmb.Name, 1)
For Each x In Me.Controls
If TypeName(x) = "ComboBox" Then If Val(Right(x.Name, 1)) > xID - 1 Then x.Clear
Next
Set rng = ws.Range(ws.Cells(2, xID), ws.Cells(ws.Rows.Count, xID).End(xlUp))
d.RemoveAll
For Each cel In rng
If cel.Offset(, -1) = txt Then
If Not d.exists(cel.Value) Then
d(cel.Value) = Empty
End If
End If
Next
If d.Count > 0 Then cmb.List = Application.Transpose(d.keys) Else cmb.Clear
End Function
Private Sub ComboBox1_Change()
setList ComboBox1.Value, ComboBox2
End Sub
Private Sub ComboBox2_Change()
setList ComboBox2.Value, ComboBox3
End Sub
Private Sub ComboBox3_Change()
setList ComboBox3.Value, ComboBox4
End Sub
Private Sub ComboBox4_Change()
setList ComboBox4.Value, ComboBox5
End Sub
Private Sub ComboBox5_Change()
setList ComboBox5.Value, ComboBox6
End Sub