VBA Userform won't work when called by macro - vba

I have a simple code that should call an Userform (CorrectiveActions) when the user inputs a value greater than 2.5 in certain cells.
Private Sub Worksheet_Change(ByVal target As Range)
If target.Count > 1 Then Exit Sub
If Not Application.Intersect(target, Me.Range("F11:F1292,K11:K1292,P11:P1292")) Is Nothing Then
If target >= 2.5 And IsNumeric(target) And Intersect(target, Me.Range("K11:K1292")) Is Nothing Or target.Offset(0, 1) >= 2.5 And Intersect(target, Me.Range("F11:F1292,P11:P1292")) Is Nothing Then CorrectiveActions.Show
End If
End Sub
The userform contains a listbox and I want to fill the cell below the one where the value greater than 2.5 is. I used the following code:
Private Sub ListBox1_Click()
Dim cellRow As Integer
Dim cellCol As Integer
cellRow = ActiveCell.Row
cellCol = ActiveCell.Column
Cells(cellRow, cellCol).Offset(1, 0).Value = ListBox1
End Sub
This Userform works fine when I launch it manually. However, when I input a value greater than 2.5 in the specified cell, the Userform shows up, but won't work. That is, the cell won't get filled.

Related

Display cell content in a text box in excel using VBA

I have a range of cells with data. I want a text box to show the cell content when I click on any cell in the text box. Is this possible? Thanks
You could just use something like this:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long
Dim lRow As Long
lRow = Cells(Rows.Count, 1).End(xlUp).Rows
For i = 1 To lRow
If Cells(i, 1).Count = 1 Then
If Cells(i, 1) = "" Then
Else
If Not Intersect(Target, Cells(i, 1)) Is Nothing Then
MsgBox (i)
End If
End If
End If
Next i
End Sub
This will show the value in a message box, not a text box. Not sure why you need a text box.
i refers to the row and change the 1 in lRow = Cells(Rows.Count, 1).End(xlUp).Rows to the correct column number you are working in
Add this to the worksheet (see the black arrow):
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
MsgBox Target.Value
End Sub
In general, if you want to check for a specific range, you can define the range in the event:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngPreselected As Range
Set rngPreselected = Range("A1:B10")
If Not Intersect(Target, rngPreselected) Is Nothing Then
MsgBox Target.Value
End If
End Sub
In this case, A1:B10 is the defined range.
That's called Event. See more about events here: http://www.cpearson.com/excel/events.aspx

How to run macro if based on other cells which automatically changes by formula

As per subject, what I need is to run macro based on other cells.
Here is the case :
cells G3 until the end of row contains data used formula =IF(B3="";"";(SUMIF('Incoming Goods'!$F$3:$F$1048576;'Current Stock'!B3;'Incoming Goods'!$M$3:$M$1048576)-(SUMIF('Outgoing Goods'!$D$4:$D$1048576;'Current Stock'!B3;'Outgoing Goods'!$J$4:$J$1048576))))--> i need to convert this formula to VBA
cells H3 should contain : If G3.value = 0 then "Out of Stock", else " "
And this sheet must be calculate every time data in G3 change automatically or any additional data on this sheet.
Already tried this code :
Private Sub Worksheet_Calculate()
Dim Current As Worksheet
Dim Rng1 As Range
Dim Target As Range
Set Current = Worksheets("Current Stock")
Set Rng1 = Current.Range("G:G")
Set Target = Range("H:H")
For Each Rng1 In Target
If Rng1.Value2 = "0" Then
Target.Value2 = "Out Of Stock"
Else
Exit Sub
End If
Next
End Sub
However, above code is Not working. Already try using Private Sub Selection Change() and Private Sub Selection Change() but still not working.
Any suggestion?
Thanks in advance
the answer to the first part is below:
ActiveCell.FormulaR1C1 = _
"=IF(R[2]C[1]="""","""",(SUMIF('Incoming Goods'!R3C6:R1048576C6,'Current Stock'!R[2]C[1],'Incoming Goods'!R3C13:R1048576C13)-(SUMIF('Outgoing Goods'!R4C4:R1048576C4,'Current Stock'!R[2]C[1],'Outgoing Goods'!R4C10:R1048576C10))))"
handy tip: to convert any excel formula to code, hit the record macro button, then click on the cell, press F2 key, then press enter, and stop recording macro. The code will now be in its own module in the vba editor.
This should do what you want.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("A1"), Target) Is Nothing Then
If IsNumeric(Target.Value) And Target.Value > 200 Then
Call YourMacroName
End If
End If
End Sub

VBA - Open a UserForm by clicking anywhere in a specific column

I would like to build a makro in VBA which opens a UserForm when I click in a cell in a specific column, for more details look here.
With this code (from Mr.Burns):
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count = 1 Then
If Not Intersect(Target, Range("A1")) Is Nothing Then
'name of userform .Show
End If
End If
End Sub
I was able to open the UserForm by clicking in the cell A1, but not by clicking in any cell inside the column A.
I tried to solve this problem with this code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count = 1 Then
Dim check As Boolean
check = True
If check Then
Dim i As Long
For i = 1 To 100000
If Not Intersect(Target, Range("A" & i)) Is Nothing Then
UserForm1.Show
check = False
End If
Next
End If
End If
End Sub
It actually works fine, but it is very slow, is there any better possibility to solve this?
To display the form when a cell is selected in column A:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' if target is one cell and in column A
If Target.Columns.count = 1 And Target.Rows.count = 1 And Target.Column = 1 Then
UserForm1.Show
End If
End Sub
You can use .count and .column property together with AND and it will become so much simple and fast. Following code triggers pop-up if u click in column A on active-sheet
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo errorhandler
If Target.Count = 1 And Target.Column = 1 Then '.count to check if only one cell is selected and .column to check if it is a first column
'UserForm1.Show
'Do whatever you want to do here like opening User form
MsgBox "You clicked in column A"
End If
errorhandler:
End Sub

Prefill a certain cell with a number when data (a letter) is entered in one cell

I'm trying to figure out a VBA code that will allow me to prefill a certain cell with a number when I type in "X" in a cell right next to it. I can't figure out if I should use Range, or Insert, or what.
I cannot use a button and assign a macro to it because I need to see which cells I have put an "X" into.
This is what I have so far, but it's using a button with macro assigned to it:
490 is being entered into E9 and tabs over to F9 after the macro button is clicked:
Sub eightNineSpring()
Range("E9").Select
ActiveCell.FormulaR1C1 = "490"
Range("F9").Select
End Sub
as automation put in the worksheet you need it:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 6 And Target.Count = 1 Then
If Target.Value = "x" Then Target.Offset(0, -1).Value = 490
End If
End Sub
or as formula in E1 then copy down
=IF(F1="x",490,"")
But keep in mind when deleting the "x" (or replace it with something different):
The function will empty the 490 again while the change event will not
When using a Change Events that makes a change, Application.Events should be turned off to avoid the code calling itself recursively.
The code below caters for one or more cells in E1:E10 being updated.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Intersect(Target, Range("F1:F10"))
If rng1 Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each rng2 In Range
If rng2.Value = "x" Then rng2.Offset(0, -1).Value = 490
Next
Application.EnableEvents = True
End Sub

Selection.Count overflow when selecting all cells

In Excel 2007 I want to prompt a message when a cell (L2) is clicked on. I have a piece of code that works but the problem is that when I select all the cells in the sheet with Ctrl+A I get error number 06: overflow on the line If Selection.Count = 1 Then
Mandatory VBA code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count = 1 Then
If Not Intersect(Target, Range("L2")) Is Nothing Then
MsgBox "ACTION!"
End If
End If
End Sub
Easily fixed:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.CountLarge = 1 Then
If Not Intersect(Target, Range("L2")) Is Nothing Then
MsgBox "ACTION!"
End If
End If
End Sub
Try this:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If InStr(1, CStr(Target.Address), ":") < 1 Then
If Selection.Count = 1 Then
If Not Intersect(Target, Range("L2")) Is Nothing Then
MsgBox "ACTION!"
End If
End If
End If
End Sub
You must change your code as follows. No Error-Traps needed:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Area.Count = 1 Then
If Not Intersect(Target, Range("L2")) Is Nothing Then
MsgBox "ACTION!"
End If
End If
End Sub
If you had 64-bit Excel I would tell you to use CountLarge instead of Count. Excel 2007 only comes in the 32-bit variety so that's not an option for you.
Your problem is that Range.Count returns a Long variable and throws an error if the number of cells is greater than a Long can store.
To get around this, you can do the following:
Use a Decimal data type stored inside a Variant. The combination can count more than the 1,048,576 rows x 16,384 columns of cells in an Excel worksheet.
Count the cells one column at a time to avoid the error with Range.Count.
I wrote a function that does that. Save this function in a regular code module (not a Worksheet or Workbook module) and use it like this:
If CountLarge32(Selection) = 1 Then
Here's the actual function:
Public Function CountLarge32(ByVal rangeOrSelection As Variant) As Variant
Dim target As Excel.Range
On Error Resume Next
Set target = rangeOrSelection
On Error GoTo 0
Dim cnt As Variant
Dim iColumn As Excel.Range
If Not target Is Nothing Then ' parameter -IS- a valid Range
' Use Range.Count on one column at a time to avoid the overflow error
' if counting higher than the limit of the Long data type.
For Each iColumn In target.Columns
cnt = CDec(cnt + iColumn.Cells.Count)
Next iColumn
CountLarge32 = cnt
End If
End Function
This function also avoids the error that occurs if Select is an object (e.g. button, shape, chart, etc.) instead of a cell.