I have a free form text box, which I'd like to populate with a value once a value is inputted in an above text box (txtStore) <-based on a 4 digit number.
here is the code I've attempted, but not sure if other subs (boolean logic) is needed to trigger something?
Dim ws as worksheet
Private Sub txtMall_Change()
Set ws = Worksheets("Lists")
Dim txtStore As Integer: txtStore = Me.txtStore.Value
txtMall.Value = Application.WorksheetFunction.IfError(VLookup(txtStore, ws.Range("A2:B1047", 2, False)), "-")
End Sub
how can I get the txtMall to populate based on that worksheet function once a value is placed in the txtStore text input? Do I need to change the procedure to something else like I'd have to with a combobox?
Untested:
Private Sub txtStore_Change()
Dim r
'Avoid possible run-time error on no match by skipping WorksheetFunction
' Instead test the return value for errors
r = Application.VLookup(CLng(Me.txtStore.Value), _
Worksheets("Lists").Range("A2:B1047"), 2, False)
txtMall.Value = IIf(iserror(r), "'-", r)
End Sub
Related
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("M1:N1").Columns(1).Value = "ΕΜΒΑΣΜΑ" Then
Columns("U").EntireColumn.Hidden = False
Columns("V").EntireColumn.Hidden = False
Else
Columns("U").EntireColumn.Hidden = True
Columns("V").EntireColumn.Hidden = True
End If
End Sub
So I have been having trouble with this code here. What I want to do is hide U, V columns if there is a value in M column called "ΕΜΒΑΣΜΑ".
Every time I let it run, it automatically hides the columns even if I have the value already in my column. Other than that, it doesn't seem to work in real time so even if I change anything, nothing happens.
Any ideas?
(a) If you want to check a whole column, you need to specify the whole column, e.g. with Range("M:M").
(b) You can't compare a Range that contains more than one cell with a value. If Range("M:M").Columns(1).Value = "ΕΜΒΑΣΜΑ" Then will throw a Type mismatch error (13). That is because a Range containing more that cell will be converted into a 2-dimensional array and you can't compare an array with a single value.
One way to check if a column contains a specific value is with the CountIf-function:
If WorksheetFunction.CountIf(Range("M:M"), "ΕΜΒΑΣΜΑ") > 0 Then
To shorten your code, you could use
Dim hideColumns As Boolean
hideColumns = (WorksheetFunction.CountIf(Range("M:M"), "ΕΜΒΑΣΜΑ") = 0)
Columns("U:V").EntireColumn.Hidden = hideColumns
Update
If you want to use that code in other events than a worksheet event, you should specify on which worksheet you want to work. Put the following routine in a regular module:
Sub showHideColumns(ws as Worksheet)
Dim hideColumns As Boolean
hideColumns = (WorksheetFunction.CountIf(ws.Range("M:M"), "ΕΜΒΑΣΜΑ") = 0)
ws.Columns("U:V").EntireColumn.Hidden = hideColumns
End Sub
Now all you have to do is to call that routine whenever you want and pass the worksheet as parameter. This could be the Workbook.Open - Event, or the click event of a button or shape. Eg put the following code in the Workbook module:
Private Sub Workbook_Open()
showHideColumns ThisWorkbook.Sheets(1)
End Sub
on a fast hand I would go like this...
maybe someone can do it shorter...
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim sht As Worksheet: Set sht = ActiveSheet
Dim c As Range
With sht.Range("M1:M" & sht.Cells(sht.Rows.Count, "M").End(xlUp).Row)
Set c = .Find("XXX", LookIn:=xlValues)
If Not c Is Nothing Then
Columns("U:V").EntireColumn.Hidden = True
Else
Columns("U:V").EntireColumn.Hidden = False
End If
End With
End Sub
I'm going crazy trying to find a way for code to run when I click on ANY of the checkboxes on my sheet. I've seen multiple articles talking about making a class module, but I can't seem to get it to work.
I have code that will populate column B to match column C. Whatever I manually type into C10 will populate into B10, even if C10 is a formula: =D9. So, I can type TRUE into D10 and the formula in C10 will result in: TRUE and then the code populates B10 to say: TRUE. Awesome... the trick is to have a checkbox linked to D10. When I click the checkbox, D10 says TRUE and the formula in C10 says TRUE, but that is as far as it goes. The VBA code does not recognize the checkbox click. If I then click on the sheet (selection change), then the code will run, so I know I need a different event.
It is easy enough to change the event to "Checkbox1_Click()", but I want it to work for ANY checkbox I click. I'm not having ANY luck after days of searching and trying different things.
here is the code I'm running so far
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long
For i = 3 To 11
Range("B" & i).Value = Range("c" & i)
Next i
End Sub
Any help would be appreciated.
this works
' this goes into sheet code
Private Sub Worksheet_Activate()
activateCheckBoxes
End Sub
.
' put all this code in class a module and name the class module "ChkClass"
Option Explicit
Public WithEvents ChkBoxGroup As MSForms.CheckBox
Private Sub ChkBoxGroup_Change()
Debug.Print "ChkBoxGroup_Change"
End Sub
Private Sub ChkBoxGroup_Click()
Debug.Print "ChkBoxGroup_Click"; vbTab;
Debug.Print ChkBoxGroup.Caption; vbTab; ChkBoxGroup.Value
ChkBoxGroup.TopLeftCell.Offset(0, 2) = ChkBoxGroup.Value
End Sub
.
' this code goes into a module
Option Explicit
Dim CheckBoxes() As New ChkClass
Const numChkBoxes = 20
'
Sub doCheckBoxes()
makeCheckBoxes
activateCheckBoxes
End Sub
Sub makeCheckBoxes() ' creates a column of checkBoxes
Dim sht As Worksheet
Set sht = ActiveSheet
Dim i As Integer
For i = 1 To sht.Shapes.Count
' Debug.Print sht.Shapes(1).Properties
sht.Shapes(1).Delete
DoEvents
Next i
Dim xSize As Integer: xSize = 2 ' horizontal size (number of cells)
Dim ySize As Integer: ySize = 1 ' vertical size
Dim t As Range
Set t = sht.Range("b2").Resize(ySize, xSize)
For i = 1 To numChkBoxes
sht.Shapes.AddOLEObject ClassType:="Forms.CheckBox.1", Left:=t.Left, Top:=t.Top, Width:=t.Width - 2, Height:=t.Height
DoEvents
Set t = t.Offset(ySize)
Next i
End Sub
Sub activateCheckBoxes() ' assigns all checkBoxes on worksheet to ChkClass.ChkBoxGroup
Dim sht As Worksheet
Set sht = ActiveSheet
ReDim CheckBoxes(1 To 1)
Dim i As Integer
For i = 1 To sht.Shapes.Count
ReDim Preserve CheckBoxes(1 To i)
Set CheckBoxes(i).ChkBoxGroup = sht.Shapes(i).OLEFormat.Object.Object
Next i
End Sub
All you need is to let EVERY checkbox's _Click() event know that you want to run the Worksheet_SelectionChange event. To do so you need to add the following line into every _Click() sub:
Call Worksheet_SelectionChange(Range("a1"))
Please note that it is irrelevant what range is passed to the SelectionChange sub since you do not use the Target in your code.
I'm having problem with a user form returning lookup values in a textbox based on the value from a drop-down list within the form. If I select an item from a list, taken from a table within the workbook, I would like a textbox in the same form to return the reference number for the item selected.
I'm using the following code:
With TestNameFuntionBox
Dim rngOWASPControls As Range
Dim ws As Worksheet
Set ws = Worksheets("List")
For Each rngOWASPControls In ws.Range("A2:D80")
Me.TestNameFunctionBox.AddItem rngOWASPControls.Value
Next rngOWASPControls
End With
It seems as though whilst the drop-down list is available in the form to select, the value returned is not being picked up for the lookup as the lookup textbox remains blank.
I've tried to enter one entry which exists in the table such as the following:
TestNameValueFunctionBox.Value = "Review Webserver"
The Lookup textbox works absolutely fine and populates the value required. I'm using the following VBA code for the reference textbox:
With OWASPRefBox
If TestNameValueFunctionBox.Value <> "" Then
OWASPRefBox.Value = Application.VLookup(TestNameValueFunctionBox.value, Worksheets("List").Range("A2:D80"), 3, FALSE)
End If
End With
I hope I've explained it well enough!
This works fine for me:
Private Sub UserForm_Initialize()
With TestNameFuntionBox
Dim rngOWASPControls As Range
Dim ws As Worksheet
Set ws = Worksheets("List")
For Each rngOWASPControls In ws.Range("A2:A80")
If rngOWASPControls <> "" Then
Me.TestNameFunctionBox.AddItem rngOWASPControls.Value
End If
Next rngOWASPControls
End With
End Sub
Private Sub TestNameFunctionBox_Change()
If TestNameFunctionBox.Value <> "" Then
OWASPRefBox.Value = Application.VLookup(TestNameFunctionBox.Value, Worksheets("List").Range("A2:D80"), 3, False)
End If
End Sub
Sample Data:
Userform at initialize:
Selecting "Cat" returns the value in column 3:
This is a basic error or lack of understanding on my part. I've searched a number of questions here and nothing seems applicable.
Here is the code
Option Explicit
Public Function ReturnedBackGroundColor(rnge As Range) As Integer
ReturnedBackGroundColor = rnge.Offset(0, 0).Interior.ColorIndex
End Function
Public Function SetBackGroundColorGreen()
ActiveCell.Offset(0, 0).Interior.ColorIndex = vbGreen
End Function
Public Function CountBackGroundColorGreen(rnge As Range) As Integer
Dim vCell As Range
CountBackGroundColorGreen = 0
For Each vCell In rnge.Cells
With vCell
If ReturnedBackGroundColor(vCell) = 14 Then
CountBackGroundColorGreen = CountBackGroundColorGreen + 1
End If
End With
Next
End Function
Public Function GetBackgroundColor() As Integer
Dim rnge As Range
GetBackgroundColor = 3
rnge = InputBox("Enter Cell to get Background color", "Get Cell Background Color")
GetBackgroundColor = ReturnedBackGroundColor(rnge)
End Function
I was adding the last function and everything else was working prior to that and am getting the error on the first statement in that function.
For the error, one of the possible fixes is to add a reference the proper library. I don't know what is the proper library to be referenced and cannot find what library the InputBox is contained. It's an activeX control but I don't see that in the tools->reference pull down. I do have microsoft forms 2.0 checked.
I've tried various set statements but I think that the only object that I've added is the inputbox.
Any suggestions?
thanks.
Use application.inputbox, add the type as range and Set the returned range object.
Option Explicit
Sub main()
Debug.Print GetBackgroundColor()
End Sub
Public Function GetBackgroundColor() As Integer
Dim rnge As Range
Set rnge = Application.InputBox(prompt:="Enter Cell to get Background color", _
Title:="Get Cell Background Color", _
Type:=8)
GetBackgroundColor = ReturnedBackGroundColor(rnge)
End Function
Public Function ReturnedBackGroundColor(rnge As Range) As Integer
ReturnedBackGroundColor = rnge.Offset(0, 0).Interior.ColorIndex
End Function
I need to assign a unique name to a cell which calls a particular user defined function.
I tried
Dim r As Range
set r = Application.Caller
r.Name = "Unique"
The following code sets cell A1 to have the name 'MyUniqueName':
Private Sub NameCell()
Dim rng As Range
Set rng = Range("A1")
rng.Name = "MyUniqueName"
End Sub
Does that help?
EDIT
I am not sure how to achieve what you need in a simple way, elegant way. I did manage this hack - see if this helps but you'd most likely want to augment my solution.
Suppose I have the following user defined function in VBA that I reference in a worksheet:
Public Function MyCustomCalc(Input1 As Integer, Input2 As Integer, Input3 As Integer) As Integer
MyCustomCalc = (Input1 + Input2) - Input3
End Function
Each time I call this function I want the cell that called that function to be assigned a name. To achieve this, if you go to 'ThisWorkbook' in your VBA project and select the 'SheetChange' event then you can add the following:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Left$(Target.Formula, 13) = "=MyCustomCalc" Then
Target.Name = "MyUniqueName"
End If
End Sub
In short, this code checks to see if the calling range is using the user defined function and then assigns the range a name (MyUniqueName) in this instance.
As I say, the above isn't great but it may give you a start. I couldn't find a way to embed code into the user defined function and set the range name directly e.g. using Application.Caller.Address or Application.Caller.Cells(1,1) etc. I am certain there is a way but I'm afraid I am a shade rusty on VBA...
I used this sub to work its way across the top row of a worksheet and if there is a value in the top row it sets that value as the name of that cell. It is VBA based so somewhat crude and simple, but it does the job!!
Private Sub SortForContactsOutlookImport()
Dim ThisCell As Object
Dim NextCell As Object
Dim RangeName As String
Set ThisCell = ActiveCell
Set NextCell = ThisCell.Offset(0, 1)
Do
If ThisCell.Value <> "" Then
RangeName = ThisCell.Value
ActiveWorkbook.Names.Add Name:=RangeName, RefersTo:=ThisCell
Set ThisCell = NextCell
Set NextCell = ThisCell.Offset(0, 1)
End If
Loop Until ThisCell.Value = "Web Page"
End Sub
I use this sub, without formal error handling:
Sub NameAdd()
Dim rng As Range
Dim nameString, rangeString, sheetString As String
On Error Resume Next
rangeString = "A5:B8"
nameString = "My_Name"
sheetString = "Sheet1"
Set rng = Worksheets(sheetString).Range(rangeString)
ThisWorkbook.Names.Add name:=nameString, RefersTo:=rng
End Sub
To Delete a Name:
Sub NameDelete()
Dim nm As name
For Each nm In ActiveWorkbook.Names
If nm.name = "My_Name" Then nm.Delete
Next
End Sub