I have a Userform with several textboxes and a command button. When the information is entered and submitted the information is transfered to the first empty row.
I need a code that would counta() text within 4 columns within that row. So translate =IF(IsBlank($A2),"",COUNTA(E2:H2) to VBA code to calculate after the user submitted the information.
Option Explicit
Sub test()
Debug.Print "Var 1 : "; CountRangeIf("not(A3="""")", Range("E3:H3"))
Dim testCriteria As Boolean
testCriteria = Not (Range("A3").Value = "")
Debug.Print "Var 2 : "; CountRangeIf_Var2(testCriteria, Range("E3:H3"))
End Sub
Public Function CountRangeIf(IfCriteriaString As String, CountRange As Range) As Variant
Dim resultCriteria As Boolean
CountRangeIf = "" ' Result = "" if Criteria is false
resultCriteria = Evaluate(IfCriteriaString)
With Application.WorksheetFunction
If resultCriteria Then
CountRangeIf = .CountA(CountRange)
End If
End With
End Function
Public Function CountRangeIf_Var2(IfCriteria As Boolean, CountRange As Range) As Variant
CountRangeIf_Var2 = "" ' Result = "" if Criteria is false
With Application.WorksheetFunction
If IfCriteria Then
CountRangeIf_Var2 = .CountA(CountRange)
End If
End With
End Function
Presuming we're using Sheet1
and presuming your Row # is already stored in
ThisRowNum variable
Following should be close to what you asked for
If Trim(CStr(Sheets("Sheet1").Range("A" & ThisRowNum).Value)) = "" then
xCtr = 0 ' Your formula used a null string - you can fix this
else
xCtr = WorksheetFunction.CountA(Sheets("Sheet1").Range("E" & ThisRowNum &":H" & ThisRowNum))
endif
The xCtr variable is the result
Related
So I have a form called "Print_Form" that has 20 checkboxes that upon form initialization take on the sheet names of the first 20 sheets of my workbook.
(no issue with the UserForm_Initialize() sub, this works fine)
Private Sub UserForm_Initialize()
CheckBox1.Caption = Sheets(1).Name
CheckBox2.Caption = Sheets(2).Name
CheckBox3.Caption = Sheets(3).Name
CheckBox4.Caption = Sheets(4).Name
CheckBox5.Caption = Sheets(5).Name
CheckBox6.Caption = Sheets(6).Name
CheckBox7.Caption = Sheets(7).Name
CheckBox8.Caption = Sheets(8).Name
CheckBox9.Caption = Sheets(9).Name
CheckBox10.Caption = Sheets(10).Name
CheckBox11.Caption = Sheets(11).Name
CheckBox12.Caption = Sheets(12).Name
CheckBox13.Caption = Sheets(13).Name
CheckBox14.Caption = Sheets(14).Name
CheckBox15.Caption = Sheets(15).Name
CheckBox16.Caption = Sheets(16).Name
CheckBox17.Caption = Sheets(17).Name
CheckBox18.Caption = Sheets(18).Name
CheckBox19.Caption = Sheets(19).Name
CheckBox20.Caption = Sheets(20).Name
End Sub
Where I am running into issues is in the following sub routine when the user clicks the print button in the form. The intention behind this button is to print all the sheets that the user has selected (i.e. the sheets that had their corresponding checkbox checked by the user). Currently, when I select multiple checkboxes and then click on the print button I get the following error; "Run-Time error '9': Subscript out of range.
Private Sub cmdPrint_Click()
Dim i As Integer
Dim cb As MSForms.Control
Dim SheetArray() As String
i = 0
'Search form for a checkbox
For Each cb In Me.Controls
i = i + 1
ReDim Preserve SheetArray(i)
'If the control is a checkbox
If TypeName(cb) = "CheckBox" Then
'and the checkbox is checked
If cb.Value = True Then
'Add the sheet to the sheet array (sheet name string was already added to the checkbox property caption; see UserForm_initialize)
SheetArray(i) = cb.Caption
End If
End If
Next cb
'Print Sheet Array
Sheets(SheetArray()).PrintOut
Unload Me
End Sub
If anyone has any ideas that would help me get this to work I would be very appreciative. Thank you in advance. :)
Try this:
Private Sub UserForm_Initialize()
Dim i As Long
For i = 1 To 20 'less typing....
Me.Controls("CheckBox" & i).Caption = Sheets(i).Name
Next i
End Sub
Private Sub cmdPrint_Click()
Dim i As Integer, s As String, sep
For i = 1 To 20
With Me.Controls("CheckBox" & i)
If .Value Then
s = s & sep & .Caption
sep = "," 'add delimiter after first item
End If
End With
Next i
Sheets(Split(s, ",")).PrintOut
Unload Me
End Sub
I want to check three different textboxes on a form (but not all) to see if any are left blank. Comparable to "If IsBlank," on the spreadsheet. From what I've read, it seems that IsEmpty can't be used this way? I've been playing with IsNull, but haven't found a proper syntax that would allow it to work. Surely there must be some simple, even standard, way of doing this? Maybe some other function I've never heard of?
(I know I can use If Txtbx1.value = "" Or If... (etc.)
—I'm looking for a shorter and more graceful way to do this.)
Thanks!
Consider using OR:
Sub dural()
If Txtbx1.Value = "" Or Txtbx2.Value = "" Or Txtbx3.Value = "" Then
MsgBox "at least one empty"
End If
End Sub
Match vs Array of Text Boxes feat. IsError, VarType and TypeName
All codes were in a user form code sheet and were run via command buttons on the user form where also the three text boxes were located.
In the first code, the result of Match is passed to the var (variant) variable and further evaluated. If there is at least one text box with no value ("" or vbNullString), var will return the position of the first found empty text box 1-based i.e. the first is 1, the second is 2 etc. unlike the Array which is 0-based i.e. the first element is 0, the second is 1 etc.
The second code is a presentation of the three choices that were studied in the first code.
The third code is a 'bad' code without variables you might be looking for.
Sub TextBoxFun()
Dim vntTB As Variant ' Text Box Array
Dim var As Variant ' Match Variant
Dim strTB As String ' Pass String
Dim lngTB As Long ' Pass Long
' Pass TextBoxes to Text Box Array.
vntTB = Array(TextBox1, TextBox2, TextBox3)
' Either:
var = Application.Match("", vntTB, 0)
' Or:
'var = Application.Match(vbNullString, vntTB, 0)
Debug.Print String(10, "'")
Debug.Print "IsError(var) = " & IsError(var) ' True
Debug.Print "VarType(var) = " & VarType(var) ' 10 or vbError
Debug.Print "TypeName(var) = " & TypeName(var) ' Error
Debug.Print String(10, "'")
' Line of Code / vbNullString Found ? >>> ' True False
Debug.Print var ' 1
' Depending on the first position of ' 2
' the found vbNullString or "". ' 3 Error 2042
lngTB = IsError(var): Debug.Print lngTB ' 0 -1
lngTB = VarType(var): Debug.Print lngTB ' 5 10
'lngTB = TypeName(var): Debug.Print lngTB ' Nope Nope
' TypeName returns always a string.
strTB = IsError(var): Debug.Print strTB ' False True
strTB = VarType(var): Debug.Print strTB ' 5 10
strTB = TypeName(var): Debug.Print strTB ' Double Error
End Sub
Sub TextBoxFunConclusion()
Dim vntTB As Variant ' Text Box Array
' Pass TextBoxes to Text Box Array.
vntTB = Array(TextBox1, TextBox2, TextBox3)
If IsError(Application.Match("", vntTB, 0)) Then
Debug.Print "No 'empty' text boxes (via IsError)."
Else
Debug.Print "At least one 'empty' text box (via IsError)."
End If
If VarType(Application.Match("", vntTB, 0)) = 10 Then
Debug.Print "No 'empty' text boxes (via VarType)."
Else
Debug.Print "At least one 'empty' text box (via VarType)."
End If
If TypeName(Application.Match("", vntTB, 0)) = "Error" Then
Debug.Print "No 'empty' text boxes (via TypeName)."
Else
Debug.Print "At least one 'empty' text box (via TypeName)."
End If
End Sub
Sub TextBoxFunMyChoice()
If IsError(Application.Match("", Array(TextBox1, TextBox2, TextBox3), 0)) _
Then
Debug.Print "No 'empty' text boxes (via IsError)."
Else
Debug.Print "At least one 'empty' text box (via IsError)."
End If
End Sub
Private Sub CommandButton1_Click()
TextBoxFun
End Sub
Private Sub CommandButton2_Click()
TextBoxFunConclusion
End Sub
Private Sub CommandButton3_Click()
TextBoxFunMyChoice
End Sub
I have a userform in which i am populating the data based on Unique ID's. I then want to give the users option to select the Unique ID through a Combo box. After that i want to populate the Company name pertaining to that Unique ID in the Text box. I am applying Vlookup for the same but it is giving me an error, "Unable to get the Vlookup property of the worksheet class function".
I have checked the values are there in the range but it is still giving me the same error.
Please help
Private Sub CBUniqueIDDSR_Change()
Me.TBParentCoDSR.Text =
Application.WorksheetFunction.VLookup(CBUniqueIDDSR.Value, Lookup_Range,
2, False)
End Sub
Private Sub UserForm_Initialize()
Application.Run "Before_Initializing"
Dim Lookup_Range As Range
sht2.Visible = True
sht3.Visible = True
Set Lookup_Range = sht3.Range("A:C")
With sht2
Me.CBMonth.List = .Range("X3", .Range("X3").End(xlDown)).Value
Me.CBCustomerCat.List = .Range("B3", .Range("B3").End(xlDown)).Value
Me.CBVertical.List = .Range("Y3", .Range("Y3").End(xlDown)).Value
Me.CBOperatingLocState.List = .Range("C3",
.Range("C3").End(xlDown)).Value
Me.CBDecisionMakingUnit.List = .Range("A3",
.Range("A3").End(xlDown)).Value
Me.CBRelationshipBuild.List = .Range("E3",
.Range("E3").End(xlDown)).Value
Me.CBGiftAllowed.List = .Range("F3", .Range("F3").End(xlDown)).Value
Me.CBDayDSR.List = .Range("I3", .Range("I3").End(xlDown)).Value
Me.CBMonthDSR.List = .Range("J3", .Range("J3").End(xlDown)).Value
Me.CBYearDSR.List = .Range("K3", .Range("K3").End(xlDown)).Value
End With
With sht3
Me.CBUniqueIDDSR.List = .Range("A2", .Range("A2").End(xlDown)).Value
End With
sht2.Visible = False
sht3.Visible = False
End Sub
Private Sub CBUniqueIDDSR_Change()
'If you Unique is in text format, use coding below
Me.TBParentCoDSR.Value = WorksheetFunction.VLookup(Me.CBUniqueIDDSR.Value, Worksheets("Sheet12").Range("A2:" & Range("B2").End(xlDown).Address), 2, False)
'If you Unique is in number format, use coding below
'Me.TBParentCoDSR.Value = WorksheetFunction.VLookup(Val(Me.CBUniqueIDDSR.Value), Worksheets("Sheet12").Range("A2:" & Range("B2").End(xlDown).Address), 2, False)
End Sub
Private Sub UserForm_Initialize()
For Each cell In Worksheets("Sheet12").Range("A2:" & Range("A2").End(xlDown).Address)
Me.CBUniqueIDDSR.AddItem cell.Value
Next
End Sub
I would like to get all checked items in a active x list box into a cell on the worksheet. I have this code that exactly does what I want as a sub:
Private Sub CommandButton1_Click()
Dim lItem As Long
Dim outstr As String
For lItem = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(lItem) = True Then
outstr = outstr & ListBox1.List(lItem) & "/"
End If
Next
Range("A1") = Left(outstr, Len(outstr) - 1)
End Sub
This takes all checked items into cell a1.
I convert this into a function like this:
Function CopySelected(lb As MSForms.ListBox) As String
Dim lItem As Long
Dim outstr As String
For lItem = 0 To lb.ListCount - 1
If lb.Selected(lItem) = True Then
outstr = outstr & lb.List(lItem) & "/"
End If
Next
CopySelected = Left(outstr, Len(outstr) - 1)
End Function
But I cannot give the right argument to the function to return the same as the sub. What do I need to put as an argument please?
I tried the following:
=Copyselected(Sheet1.ListBox1)
=Copyselected(Sheet1.ListBoxes("ListBox1"))
=Copyselected(Sheet1.Shapes("ListBox1").OLEFormat.Object)
=Copyselected(Worksheets("Sheet1").ListBox1)
Nothing seem to work. Is the function incorrect or the passing?
Use the following code:
Public Function GetAllSelected(strListBox As String)
Dim lItem As Long
Dim outstr As String
With Worksheets(1).OLEObjects(strListBox).Object
For lItem = 0 To .ListCount - 1
If .Selected(lItem) = True Then
outstr = outstr & .List(lItem) & "/"
End If
Next lItem
End With
GetAllSelected = Left(outstr, Len(outstr) - 1)
End Function
Then call it passing the name of the ListBox as a string:
=GetAllSelected("ListBox1")
Note, that the sheet must be know at this time. If you need to pass the sheet name (as well) to the function then you will have to adjust the code accordingly.
Update:
For the proactive approach as outlined in the comments below using the ListBox1_Change() event the result would be something like this:
Yet, in this case you would have one procedure for each ListBox and the result of the sub would be always written into the same cell (hard-coded).
Using code from #Ralph, you should also be able to use your function as is...
Try...
=Copyselected(Sheet1.OLEObjects("ListBox1").Object)
Can anyone tell me how to improve this macro?
All the macro does is it just reads an Excel file for a list a accounts to update in an application (SmarTerm Beta). It technically already accomplishes the goal, but is there a way to code it so that while it’s reading the Excel file, the coordinates of the cells from which to read the account numbers and also the coordinates of the cells in which to write an output don’t depend on a "pre-selected" a cell? The risk with selecting a cell is that if someone were to accidentally select a different cell while the macro is running, everything will get screwed up.
Here's my current code:
Public oExcelObj As Object
Function WaitSystem(Optional NoDialog as Variant) As Boolean
Dim nContinue as Integer
Dim nTimeOut as Integer 'In seconds.
'The default timeout for each command is 3 minutes.
'Increase this value if your host requires more time
'for each command.
nTimeOut = 10
If IsMissing(NoDialog) then NoDialog = False
'Wait for response from host.
Session.EventWait.Timeout = nTimeOut
Session.EventWait.EventType = smlPAGERECEIVED
Session.EventWait.MaxEventCount = 1
WaitSystem = True
If Session.EventWait.Start = smlWAITTIMEOUT Then
If NoDialog Then
WaitSystem = False
Else
nContinue = QuerySyncError()
If nContinue <> ebYes then WaitSystem = False
End If
End If
Set LockStep = Nothing
End Function
'Establish link. Search for Excel.
Function OleLinkConnection
Const XlMaximized = &HFFFFEFD7
Titlebar$ = AppFind$("Microsoft Excel")
If Titlebar$ <> "" Then
bIsExcelActive = True
If AppGetState(Titlebar$) = ebMinimized Then
AppSetState 2, Titlebar$
End If
Else
bIsExcelActive = False
End If
If bIsExcelActive Then
'Create Excel Object using current instance of Excel.
Set oExcelObj = GetObject(, "Excel.Application")
Else
'Create Excel Object using a new instance of Excel.
Set oExcelObj = CreateObject("Excel.Application")
End If
Version = oExcelObj.Application.Version
oExcelObj.ScreenUpdating = True
oExcelObj.Displayalerts = True
oExcelObj.Visible = true
End Function
Sub JPBmacro
Dim AccountNumber As String
Dim Temp As Integer
Begin Dialog StartDialogTemplate ,,211,74,"Run JPBmacro?"
OKButton 60,12,92,20,.Proceed
CancelButton 60,40,92,20,.Exit
End Dialog
Dim StartDialog As StartDialogTemplate
r% = Dialog(StartDialog)
If r% = 0 Then End
g$ = "G:\DATA\outputfile.xlsx"
oleCode = OleLinkConnection
oExcelObj.Workbooks.Open g$
oExcelObj.Range("A1").Select ‘<----This selects the cell from which all coordinates are based off of. The coordinates of oExcelObj.ActiveCell.Offset(Y,X).Value VBA depend on selecting a cell.
NEXTACCOUNT:
Temp = 0
AccountNumber = oExcelObj.ActiveCell.Offset(Temp,0).Value
While AccountNumber <> ""
Session.SendKey "CLEAR"
If WaitSystem = False Then End
Session.Send "ACTU " & AccountNumber
Session.SendKey "ENTER"
If WaitSystem = False Then End
If Trim(Session.ScreenText(4,6,1,22)) = "INVALID ACCOUNT NUMBER" Or Trim(Session.ScreenText(4,6,1,19)) = "ACCOUNT NOT ON FILE" Then
oExcelObj.ActiveCell.Offset(Temp,1).Value = Trim(Session.ScreenText(4,6,1,22))
GoTo RESTARTLOOP
End If
UPDATEIOV:
If Trim(Session.ScreenText(13,76,1,1)) = "Y" Then
oExcelObj.ActiveCell.Offset(Temp,1).Value = "Account already flagged as institutional."
Else
Session.Row = 13
Session.Column = 76
Session.send "Y"
Session.SendKey "ENTER"
If WaitSystem = False Then End
oExcelObj.ActiveCell.Offset(Temp,1).Value = Trim(Session.ScreenText(24,2,1,50))
End If
RESTARTLOOP:
Temp = Temp + 1
AccountNumber = oExcelObj.ActiveCell.Offset(Temp,0).Value
Wend
ENDNOW:
oExcelObj.Workbooks.Close
MsgBox "All Done!"
End Sub
Why not keep the reference to the first cell?
Dim rng as Range
Set rng = oExcelObj.Range("A1")
i=1
...
x = rng.Cell(i,1).Value
'Or faster yet is reading all the values into an variant array.
Dim array() as Variant
array = rng.Resize(N,M).Value
' Work with array as
x = array(i,1)
Given the comment from assylias and that another poster has since "answered" with this approach:
I can't see where oExcelObj is instantiated? Or how you are referring to a specific sheet.
Regardless of which,
you can avoid select by setting a range, ie Set rng1 = oExcelObj.Sheets(1).Range("A1")
and then use offsets from rng1.
The user won't be able to interfere while the code is running