I'm sure you will find the problem that I'm uncapable to do.
Below you can see a resume of the code in which I have the problem.
After changing the value in the combobox1 it shows an error "Compile error. Argument not optional", highlighting in yellow "Sub ComboBox1_Change()" and in blue "Call TextBox4_Exit".
I think I'm doing something wrong with the arguments needed but don't know how to handle.
Thank you for your help.
Sub ComboBox1_Change()
If TextBox4.Visible = True And TextBox4.Value <> "" Then
Call TextBox4_Exit
End If
Sub TextBox4_Exit(ByVal cancel As MSForms.ReturnBoolean)
Dim placas As String
placas = TextBox4.Value
I = 3
While Range("E" & I).Value <> ""
If Range("E" & I).Value = mensaje Then
If Range("L" & I).Value = mensaje2 Then
If sheet1 = "SIC" Then
Range("X" & I).Value = placas
TextBox11.Value = Range("Y" & I).Value
TextBox10.Value = Range("Z" & I).Value
Else
Range("U" & I).Value = placas
TextBox11.Value = Range("AN" & I).Value
End If
End If
End If
I = I + 1
Wend
End Sub
First, the Sub TextBox4_Exit(ByVal cancel As MSForms.ReturnBoolean) has one argument and it's not marked as Optional,so you need to pass a parameter to Call TextBox4_Exit.
Second, did you miss your End Sub of ComboBox1_Change()?
Related
I've got the below code and it works completely fine for rows 1 - 46 on it's own populating one table. As soon as I replicate this with a second table to populate it throws Error1.
I've taken out everything below "' Second Table Entry " and works fine ... put back in and same error. On the "Home" sheet it actually populates the tables information but still throws the error which is stopping further vba from executing.
Any ideas? I've been all over google, stackoverflow, superuser and Microsoft MSDN and can't figure out where in the second bit of code is causing it to error.
EDIT: I've checked the debugger and it's highlighting the below code in the second table inserts
With Worksheets("Home")
.Hyperlinks.Add Anchor:=.Range("H" & row_ptr), _
Address:="", _
SubAddress:=AddStr, _
TextToDisplay:=Workbooks(ActiveWorkbook.Name).Worksheets("Audit_InFlight").Range("D" & i).Value
End With
Any help is greatly appreciated.
Error1
Run-time error '5': Invalid procedure call or argument
Private Sub Workbook_Open()
Dim row_ptr As Long
Dim i As Long
Dim i2 As Long
Dim rownbrMA_Inflight As Long
Dim rownbrAudit As Long
Dim CurrentWorkbook As Workbook
Dim InputWorksheet As Worksheet
Dim DataSourceWorksheet As Worksheet
Dim AuditDataSourceWorksheet As Worksheet
Set CurrentWorkbook = Workbooks(ActiveWorkbook.Name)
Set InputWorksheet = CurrentWorkbook.Sheets("Home")
Set DataSourceWorksheet = CurrentWorkbook.Sheets("MA_Inflight")
Set AuditDataSourceWorksheet = CurrentWorkbook.Sheets("Audit_InFlight")
InputWorksheet.Range("A30:M176").Clear
InputWorksheet.Range("A30:M176").ClearFormats
InputWorksheet.Range("A30:M176").Interior.Color = RGB(255, 255, 255)
rownbrMA_Inflight = DataSourceWorksheet.Range("C" & Rows.Count).End(xlUp).Row
row_ptr = 31
For i = 8 To rownbrMA_Inflight
If DataSourceWorksheet.Range("C" & i).Value = "Open" Then
InputWorksheet.Rows(row_ptr).Insert Shift:=xlDown 'CopyOrigin:=xlFormatFromLeftOrAbove
InputWorksheet.Range("A" & row_ptr).Value = DataSourceWorksheet.Range("E" & i).Value
InputWorksheet.Range("B" & row_ptr).Value = DataSourceWorksheet.Range("F" & i).Value
AddStr = "MA_Inflight!" & "$F$" & CStr(i)
ActiveWorkbook.Activate
Worksheets("Home").Activate
With Worksheets("Home")
.Hyperlinks.Add Anchor:=.Range("B" & row_ptr), _
Address:="", _
SubAddress:=AddStr, _
TextToDisplay:=Workbooks(ActiveWorkbook.Name).Worksheets("MA_Inflight").Range("F" & i).Value
End With
InputWorksheet.Range("C" & row_ptr).Value = DataSourceWorksheet.Range("I" & i).Value
InputWorksheet.Range("D" & row_ptr).Value = DataSourceWorksheet.Range("J" & i).Value
InputWorksheet.Range("E" & row_ptr).Value = DataSourceWorksheet.Range("L" & i).Value
row_ptr = row_ptr + 1
End If
Next i
'============================================================
' Second Table Entry
'============================================================
rownbrAudit = DataSourceWorksheet.Range("C" & Rows.Count).End(xlUp).Row
row_ptr = Empty
row_ptr = 31
For i = 8 To rownbrAudit
If AuditDataSourceWorksheet.Range("B" & i).Value <> "Closed" Then
InputWorksheet.Rows(row_ptr).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
InputWorksheet.Range("G" & row_ptr).Value = AuditDataSourceWorksheet.Range("B" & i).Value
InputWorksheet.Range("H" & row_ptr).Value = AuditDataSourceWorksheet.Range("D" & i).Value
'New code ---------------------------
AddStr = "Audit_InFlight!" & "$D$" & CStr(i)
ActiveWorkbook.Activate
Worksheets("Home").Activate
With Worksheets("Home")
.Hyperlinks.Add Anchor:=.Range("H" & row_ptr), _
Address:="", _
SubAddress:=AddStr, _
TextToDisplay:=Workbooks(ActiveWorkbook.Name).Worksheets("Audit_InFlight").Range("D" & i).Value
End With
'-----------------------------------
InputWorksheet.Range("I" & row_ptr).Value = AuditDataSourceWorksheet.Range("G" & i).Value
InputWorksheet.Range("J" & row_ptr).Value = AuditDataSourceWorksheet.Range("H" & i).Value
InputWorksheet.Range("K" & row_ptr).Value = AuditDataSourceWorksheet.Range("I" & i).Value
InputWorksheet.Range("L" & row_ptr).Value = AuditDataSourceWorksheet.Range("J" & i).Value
InputWorksheet.Range("M" & row_ptr).Value = AuditDataSourceWorksheet.Range("K" & i).Value
row_ptr = row_ptr + 1
End If
Next i
'RemoveBlankCells
'PURPOSE: Deletes single cells that are blank located inside a designated range
Dim rng As Range
'Store blank cells inside a variable
Set rng = InputWorksheet.Range("A30:E50").SpecialCells(xlCellTypeBlanks)
'Delete blank cells and shift upward
rng.Rows.Delete Shift:=xlShiftUp
End Sub
I am attempting to write some VBA that will accomplish
if row O is not null then copy all data to new row, then in current row clear columns I, J, K, L, M, N
in the newly inserted row clear columns O
The caveat I am not sure to account for is - throws a
Type mismatch error
Here is the syntax that I am trying to work with
Sub BlueBell()
Application.ScreenUpdating = False
Dim i As Long, y
ReDim y(2 To Range("A" & Rows.Count).End(3).Row)
For i = UBound(y) To LBound(y) Step -1
If Cells(i, "O") Then
If Cells(i, "I") = "" And Cells(i, "K") = "" And Cells(i, "M") = "" Then
GoTo DoNothing
Else
Rows(i).Copy
Cells(i, "A").Insert
Range("I" & i & ":J" & i & ":K" & i & ":L" & i & ":M" & i & ":N" & i & ":O" & i + 1).ClearContents
GoTo DoNothing
End If
End If
DoNothing:
Next i
End Sub
Apart from your error with using a string as a boolean expression, there are several things that can be changed in your code:
Sub BlueBell()
Application.ScreenUpdating = False
Dim i As Long ', y() As Variant
'ReDim y(2 To Range("A" & Rows.Count).End(3).Row) 'Why use an array?
For i = Range("A" & Rows.Count).End(3).Row To 2 Step -1
If Not IsEmpty(Cells(i, "O").Value) Then
'Avoid the use of GoTo
If Cells(i, "I").Value <> "" Or _
Cells(i, "K").Value <> "" Or _
Cells(i, "M").Value <> "" Then
Rows(i).Copy
Cells(i, "A").Insert
'Don't use a "Ix:Jx:Kx:Lx:Mx:Nx:Ox+1" range - it will lead to problems
'because even really experienced users don't understand what it does
Range("I" & i & ":N" & i).ClearContents
Range("O" & i + 1).ClearContents
End If
End If
Next i
'It's a good habit to reset anything that you disabled at the start of your code
Application.ScreenUpdating = True
End Sub
I'm trying to create a Macro that will modify contents in columns S, W and AH based on the content in AB
e.g. if AB1 = No, then S1=C-MEM, AH = N/A and W is cleared.
For some reason, I get a 'Type mismatch' error on the first line of my if statement and can't figure out why or how to fix it - even after reading other posts about similar issue.
Sub test()
Dim lastrow As Long
Dim i As Long
lastrow = Range("AB" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
**-> If Range("AB" & i).Value = "No" Then
Range("S" & i).Value = "C-MEM"
Range("W" & i).Value = ""
Range("AH" & i).Value = "N/A"
End If
Next i
End Sub
Thanks
You are trying to test if an error is = No.
Test for the error and skip the logic in that loop:
Sub test()
Dim lastrow As Long
Dim i As Long
lastrow = Range("AB" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
If Not IsError(Range("AB" & i).Value) Then
If Range("AB" & i).Value = "No" Then
Range("S" & i).Value = "C-MEM"
Range("W" & i).Value = ""
Range("AH" & i).Value = "N/A"
End If
End If
Next i
End Sub
I have a question that how to pull the questions one after the other if the student clicks on next button.
Here I have two excel workbook and one is master workbook and the other one is for the tool designed for giving test (student will view this).
Sub Button1_Click()
Dim s(6 To 100) As String`enter code here`
Dim stname As String
Dim neWb As Workbook
Dim mypath As String
Dim u As String
u = "_xlsx"
Application.DisplayAlerts = False
For i = 6 To 100
s(i) = Range("E" & i).Value
stname = s(i) & "" & u
If s(i) = "" Then
ActiveWorkbook.Open = False
End If
On Error GoTo jamun:
mypath = Range("B1").Value & "\" & stname
Set neWb =Workbooks.Open("anypath\nanoo.xls")'It can be c drive or any other drive in the system
neWb.SaveAs filename:=mypath
neWb.Close
Range("B" & i).Value = mypath & "_assigning..."
Application.Wait Now + TimeValue("00:00:02")
Range("F" & i).Value = "Done"
Range("B" & i).Value = mypath & "_assigned"
Application.Wait Now + TimeValue("00:00:01")
Range("B" & i).Select
'Adding hyper link to all the lines that shows the status to whom it has been assigned and to whom it is yet to assign
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="mypath", TextToDisplay:=Range("B" & i).Value
Range("B" & i).Select
Selection.Hyperlinks(1).Address = Range("B1").Value
Next
MsgBox "Test assigned successfully"
Exit Sub
jamun:
MsgBox "Test assigned successfully"
End Sub
Please help me for the list boxes.
What I am trying to do is:
I selected two items from list box and moved them to right.
I saved Excel file. I reopened the file and nothing was present in the right.
Please help. I have used following code in VBA:
Private Sub CommandButton6_Click()
Dim iCtr As Long
For iCtr = 0 To Me.ListBox2.ListCount - 1
Me.ListBox1.AddItem Me.ListBox2.List(iCtr)
Next iCtr
Me.ListBox2.Clear
End Sub
Private Sub BTN_moveAllRight_Click()
Dim iCtr As Long
For iCtr = 0 To Me.ListBox1.ListCount - 1
Me.ListBox2.AddItem Me.ListBox1.List(iCtr)
Next iCtr
Me.ListBox1.Clear
End Sub
Private Sub BTN_MoveSelectedLeft_Click()
Dim iCtr As Long
For iCtr = 0 To Me.ListBox2.ListCount - 1
If Me.ListBox2.Selected(iCtr) = True Then
Me.ListBox1.AddItem Me.ListBox2.List(iCtr)
End If
Next iCtr
For iCtr = Me.ListBox2.ListCount - 1 To 0 Step -1
If Me.ListBox2.Selected(iCtr) = True Then
Me.ListBox2.RemoveItem iCtr
End If
Next iCtr
End Sub
Private Sub BTN_MoveSelectedRight_Click()
Dim iCtr As Long
For iCtr = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(iCtr) = True Then
Me.ListBox2.AddItem Me.ListBox1.List(iCtr)
End If
Next iCtr
For iCtr = Me.ListBox1.ListCount - 1 To 0 Step -1
If Me.ListBox1.Selected(iCtr) = True Then
Me.ListBox1.RemoveItem iCtr
End If
Next iCtr
End Sub
Private Sub cmdOK_Click()
Unload Me
End Sub
Private Sub Worksheet_Activate()
Dim myCell As Range
Dim rngItems As Range
Set rngItems = Sheets("Subject Disposition").Range("Route")
Me.ListBox1.Clear
Me.ListBox2.Clear
With Me.ListBox1
.LinkedCell = ""
.ListFillRange = ""
For Each myCell In rngItems.Cells
If Trim(myCell) <> "" Then
.AddItem myCell.Value
End If
Next myCell
End With
Me.ListBox1.MultiSelect = fmMultiSelectMulti
Me.ListBox2.MultiSelect = fmMultiSelectMulti
End Sub
I made a sample for you.
First set up the Source Sheet (in this sample, we use Sheet1) and the UserForm like what you see below:
As you can see, we have the initial data or list in Cell A1:A10 in Sheet1.
To display it in the UserForm you created, you use RowSource property as seen in UserForm_Initialize event as what David pointed out. (See below)
And then you see the codes for the rest of the buttons which moves items selected from left to right and vise versa.
Also the move all to left or right button.
Basically, what we're doing is manipulating Range Objects in Sheet1 and then updates the RowSource property at the end of each code block to make it look like we are manipulating the Listboxes.
Now when you save the worksheet, It will retain whatever value Ranges A1:A10 and B1:B10 have. HTH
Option Explicit
Private Sub CommandButton1_Click() 'move item right to left
Dim rng As Range
Dim i As Long, j As Long
With Me.ListBox2 'right listbox
For i = 0 To .ListCount - 1
If .Selected(i) = True Then
Set rng = Sheet1.Range("B1:B10").Find(.List(i), [B10])
If Not rng Is Nothing Then
With Sheet1
If Len(.Range("A1").Value) = 0 Then
j = 1
Else
j = .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0).Row
End If
rng.Copy .Range("A" & j)
rng.Delete xlUp
End With
End If
End If
Next
End With
DoEvents
Me.ListBox1.RowSource = _
"'[" & ThisWorkbook.Name & "]" & Sheet1.Name & "'!" & "A1:A10"
Me.ListBox2.RowSource = _
"'[" & ThisWorkbook.Name & "]" & Sheet1.Name & "'!" & "B1:B10"
End Sub
Private Sub CommandButton2_Click() 'move item left to right
Dim rng As Range
Dim i As Long, j As Long
With Me.ListBox1 'left listbox
For i = 0 To .ListCount - 1
If .Selected(i) = True Then
Set rng = Sheet1.Range("A1:A10").Find(.List(i), [A10])
If Not rng Is Nothing Then
With Sheet1
If Len(.Range("B1").Value) = 0 Then
j = 1
Else
j = .Range("B" & .Rows.Count).End(xlUp).Offset(1, 0).Row
End If
rng.Copy .Range("B" & j)
rng.Delete xlUp
End With
End If
End If
Next
End With
DoEvents
Me.ListBox1.RowSource = _
"'[" & ThisWorkbook.Name & "]" & Sheet1.Name & "'!" & "A1:A10"
Me.ListBox2.RowSource = _
"'[" & ThisWorkbook.Name & "]" & Sheet1.Name & "'!" & "B1:B10"
End Sub
Private Sub CommandButton3_Click() 'move all to left
Dim rng As Range
With Sheet1
If Me.ListBox2.ListCount = 0 Then Exit Sub
Set rng = .Range("B1", .Range("B" & .Rows.Count).End(xlUp))
If Len(.Range("A1").Value) = 0 Then
rng.Copy .Range("A1")
Else
rng.Copy .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0)
End If
rng.ClearContents
End With
DoEvents
Me.ListBox1.RowSource = _
"'[" & ThisWorkbook.Name & "]" & Sheet1.Name & "'!" & "A1:A10"
Me.ListBox2.RowSource = _
"'[" & ThisWorkbook.Name & "]" & Sheet1.Name & "'!" & "B1:B10"
End Sub
Private Sub CommandButton4_Click() 'move all to right
Dim rng As Range
With Sheet1
If Me.ListBox1.ListCount = 0 Then Exit Sub
Set rng = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
If Len(.Range("B1").Value) = 0 Then
rng.Copy .Range("B1")
Else
rng.Copy .Range("B" & .Rows.Count).End(xlUp).Offset(1, 0)
End If
rng.ClearContents
End With
DoEvents
Me.ListBox1.RowSource = _
"'[" & ThisWorkbook.Name & "]" & Sheet1.Name & "'!" & "A1:A10"
Me.ListBox2.RowSource = _
"'[" & ThisWorkbook.Name & "]" & Sheet1.Name & "'!" & "B1:B10"
End Sub
Private Sub UserForm_Initialize()
'Initialize the left and right listbox value
Me.ListBox1.RowSource = _
"'[" & ThisWorkbook.Name & "]" & Sheet1.Name & "'!" & "A1:A10"
Me.ListBox2.RowSource = _
"'[" & ThisWorkbook.Name & "]" & Sheet1.Name & "'!" & "B1:B10"
End Sub