I have a userform with listbox. In the userform the user required to add values in several textboxs, the values automatically are added to an excel table, and the listbox supposed to show the specific values which were added by the user. I have tried to use with Dynamic range through the manager name, and set the rowsource of the listbox to contain the dynamic range, but the listbox is empty and doesn't show any value.
Please your hlp to understand what i'm doing wrong?
The dynamic range is:
Dyn_CurrentCA= =OFFSET(CA_list!$F$4,lists!$V$10,0,lists!$V$9,6)
This is my code:
Public Dep_CA As Integer
Public Target_CA As Integer
Private Sub CB_Add_Click()
Target_CA = Sheets("lists").Range("V8").Value + 1
If T_AuditDate.Value = "" Or CB_Grade.Value = "" Or
T_CAnum.Value = "" Or CB_Subject.Value = "" Or
T_Findings.Value = "" Then
MsgBox "Please fill Audit Date and Audit Result!",
vbRetryCancel + vbCritical, "Data is missing"
Else
Sheets("CA_list").Range("CA_Start").Offset(Target_CA, 0).Value = Target_CA
Sheets("CA_list").Range("CA_Start").Offset(Target_CA, 1).Value = L_Dep.Caption
Sheets("CA_list").Range("CA_Start").Offset(Target_CA, 2).Value = T_AuditDate.Value
Sheets("CA_list").Range("CA_Start").Offset(Target_CA, 3).Value = L_Contact.Caption
Sheets("CA_list").Range("CA_Start").Offset(Target_CA, 4).Value = L_Manager.Caption
Sheets("CA_list").Range("CA_Start").Offset(Target_CA, 5).Value = T_CAnum.Value
Sheets("CA_list").Range("CA_Start").Offset(Target_CA, 6).Value = CB_Subject.Value
Sheets("CA_list").Range("CA_Start").Offset(Target_CA, 7).Value = CB_SubSubject.Value
Sheets("CA_list").Range("CA_Start").Offset(Target_CA, 8).Value = T_Findings.Value
Sheets("CA_list").Range("CA_Start").Offset(Target_CA, 9).Value = T_DD.Value
Sheets("CA_list").Range("CA_Start").Offset(Target_CA, 10).Value = CB_Status.Value
Call clear_CA
Dep_CA = Dep_CA + 1
Sheets("lists").Range("V9").Value = Dep_CA
ListBox1.RowSource = Dyn_CurrentCA
End If
End Sub
Private Sub UserForm_Initialize()
Dep_CA = 0 'initialize no. of lines to 0
Sheets("lists").Range("V9").Value = Dep_CA
CurrentRaw = Sheets("lists").Range("V3").Value
Sheets("lists").Range("V10").Value = Sheets("lists").Range("V8").Value + 1
L_Dep.Caption = Sheets("lists").Range("V5").Value
L_Site.Caption = Sheets("Internal_Plan").Range("A_Start").Offset(CurrentRaw, 4).Value
L_PQ.Caption = Sheets("Internal_Plan").Range("A_Start").Offset(CurrentRaw, 5).Value
L_PYear.Caption = Sheets("Internal_Plan").Range("A_Start").Offset(CurrentRaw, 6).Value
L_Auditor.Caption = Sheets("Internal_Plan").Range("A_Start").Offset(CurrentRaw, 7).Value
L_Contact.Caption = Sheets("Internal_Plan").Range("A_Start").Offset(CurrentRaw, 2).Value
L_Manager.Caption = Sheets("Internal_Plan").Range("A_Start").Offset(CurrentRaw, 3).Value
Call clear_CA
With ListBox1
.ColumnWidths = "40;60;60;260;50;40"
.ColumnCount = 6
.RowSource = Dyn_CurrentCA
.ColumnHeads = True
End With
End Sub
Sub clear_CA()
With Update_Results 'name of userform
CB_Subject.Value = ""
CB_SubSubject.Value = ""
T_CAnum.Value = ""
T_DD.Value = ""
CB_Status.Value = "Open"
T_Findings.Value = ""
End With
End Sub
This is the userform with listbox:
Try with using the address of the dynamic range. You need to add the sheet name as well.
ListBox1.RowSource = Worksheets("CA_list").Range("Dyn_CurrentCA").Address(external:=True)
For ActiveX
ListBox1.ListFillRange = Worksheets("CA_list").Range("Dyn_CurrentCA").Address(external:=True)
I have a simple user form that collects informations about persons.
Here an example of what I get when I added informations of 6 persons. I want to start the list of informations from the 3th row (since the 2 first ones are filled by Command button "Remplir formulaire" :
My issue is that I would like, at the calling of userForm, to have 14 headers names for each first 14 columns (the functions to fill the values into these columns will be done later in my code).
To set the names of the 14 fields (starting from row=3), I did :
Private Sub ResetForm()
'Monsieur by default
ComboBox1.Value = "Monsieur"
'Empty TextBox1
TextBox1.Value = ""
'Empty TextBox2
TextBox2.Value = ""
'Empty TextBox3
TextBox3.Value = ""
End Sub
Private Sub UserForm_Initialize()
'Create header for each colum
Dim HeaderName(14) As String
'Index to browse HeaderName array
Dim a As Integer
HeaderName(1) = "Civilité"
HeaderName(2) = "Nom"
HeaderName(3) = "Prénom"
HeaderName(4) = "Âge"
HeaderName(5) = "Fonction"
HeaderName(6) = "Entité"
HeaderName(7) = "Catégorie"
HeaderName(8) = "Adresse"
HeaderName(9) = "Code postal"
HeaderName(10) = "Ville"
HeaderName(11) = "Tél Fixe"
HeaderName(12) = "Tél Portable"
HeaderName(13) = "Email"
HeaderName(14) = "Autres infos"
'Initlialize headers : start from row = 3
Sheet1.Activate
With Sheet1
For a = 1 To 14
If (.Cells(3, a) <> "") Then
.Cells(3, a).Value = HeaderName(a)
End If
Debug.Print "a = " & a
Next a
End With
'Fill ComboBox
With ComboBox1
.AddItem "Monsieur"
.AddItem "Madame"
End With
'Set Elu by default
CheckBox1.Value = True
CheckBox2.Value = False
'Reset all inputs
Call ResetForm
End Sub
and into the same VBA source, I did for Command button" "Remplir Formulaire" :
Private Sub CommandButton1_Click()
Dim emptyRow As Long
Sheet1.Activate
With Sheet1
emptyRow = .UsedRange.Rows.Count + .UsedRange.Rows(1).Row - 1
If .Cells(emptyRow, 1).Value <> "" Then
emptyRow = emptyRow + 1
.Cells(emptyRow, 1).Value = ComboBox1.Value
.Cells(emptyRow, 2).Value = TextBox1.Value
.Cells(emptyRow, 3).Value = TextBox2.Value
.Cells(emptyRow, 4).Value = TextBox3.Value
.Cells(emptyRow, 5).Value = CheckBox1.Value
If CheckBox1.Value = True Then
.Cells(emptyRow, 5).Value = CheckBox1.Caption
Else
.Cells(emptyRow, 5).Value = CheckBox2.Caption
End If
End If
End With
End Sub
So I don't understand why I can't get the 14 names of each top column specified in function UserForm_Initialize() by HeaderName array; only the first four ones (Civilité, Nom, Prénom, Age) are displayed when I click on "Remplir Formulaire" command button, not the 10 others.
What might be wrong here?
Do you really need to check if the cell is empty? I would replace the 20+ lines of code with:
Sheet1.Range("A3").Resize(1, 14).Value = Array("Civilité", "Nom", "Prénom", "Âge", "Fonction", "Entité", "Catégorie", "Adresse", "Code postal", "Ville", "Tél Fixe", "Tél Portable", "Email", "Autres infos")
I am doing a scanning Barcode system by using form.
This is how the form works:
User will scan the barcode into "Packing QR Code Serial Number".
Form will compare "Packing QR Code Serial Number" with "Part QR Code Serial Number". If same, shows "OK". Then, the last 7 number is choosen out and increase 1; if not, show "NG" and setfocus back to "Packing QR Code Serial Number".
However, Excel showed "Run Time Error 13" and stuck on the +1 formula".
May I know why is this happen? Any mistake on the code ?
Thanks
_____________________________________________________________________________
Private Sub PackingSNTextBox_AfterUpdate()
Dim emptyRow As Long, Temp1 As String, Temp1A As Long, Temp1B As String, Temp2 As String, Temp11 As Long, Temp1AA As String, Temp3 As String
'Make Sheet1 active
Sheet1.Activate
PartSNTextBox.Enabled = True
If PartSNTextBox.Value = PackingSNTextBox.Value Then
Label8.BackColor = vbGreen
Temp1 = Right(PackingSNTextBox.Value, 7)
Temp11 = CLng(Temp1)
Temp1A = Temp11 + 1
Temp1AA = CStr(Temp1A)
Temp1B = Right("0000000" & Temp1AA, 7)
Temp3 = Left(PackingSNTextBox.Value, 9)
Temp2 = Temp3 & Temp1B
'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
'Transfer information
Cells(emptyRow, 1).Value = Label13
Cells(emptyRow, 2).Value = Label14
Cells(emptyRow, 3).Value = Now
Cells(emptyRow, 4).Value = PartSNTextBox.Value
Cells(emptyRow, 5).Value = PackingSNTextBox.Value
NextSNTextBox.Value = Temp2
Cells(emptyRow, 8).Value = Temp2
PartSNTextBox.Value = ""
PackingSNTextBox.Value = ""
PartSNTextBox.SetFocus
Else
ClearButton.Enabled = False
Label9.BackColor = vbRed
MsgBox ("Wrong Pairing")
PackingSNTextBox = ""
PackingSNTextBox.SetFocus
End If
End Sub
The AfterUpdate event fires before the control's value is changed. Use the Change() event instead.
Here is my simple test:
Private Sub PackingSNTextBox_AfterUpdate()
lblPackingSNTextBox_AfterUpdate.Caption = "PackingSNTextBox_AfterUpdate: " & PartSNTextBox.Value
End Sub
Private Sub PartSNTextBox_Change()
lblPartSNTextBox_Change.Caption = "PartSNTextBox_Change: " & PartSNTextBox.Value
End Sub
Private Sub PartSNTextBox_Change()
Dim Temp1 As String, Temp1A As Long, Temp1B As String, Temp2 As String, Temp11 As Long, Temp1AA As String, Temp3 As String
PartSNTextBox.Enabled = True
If PartSNTextBox.Value = PackingSNTextBox.Value Then
Label8.BackColor = vbGreen
Temp1 = Right(PackingSNTextBox.Value, 7)
Temp11 = getNumbersFromString(Temp1)
Temp1A = Temp11 + 1
Temp1AA = CStr(Temp1A)
Temp1B = Right("0000000" & Temp1AA, 7)
Temp3 = Left(PackingSNTextBox.Value, 9)
Temp2 = Temp3 & Temp1B
With Sheet1
With .Range("A" & .Rows.Count).Offset(1)
'Transfer information
.Value = Label13
.Offset(0, 1).Value = Label14
.Offset(0, 2).Value = Now
.Offset(0, 3).Value = PartSNTextBox.Value
.Offset(0, 4).Value = PackingSNTextBox.Value
End With
End With
NextSNTextBox.Value = Temp2
Cells(emptyRow, 8).Value = Temp2
PartSNTextBox.Value = ""
PackingSNTextBox.Value = ""
PartSNTextBox.SetFocus
Else
ClearButton.Enabled = False
Label9.BackColor = vbRed
MsgBox ("Wrong Pairing")
PackingSNTextBox = ""
PackingSNTextBox.SetFocus
End If
End Sub
Function getNumbersFromString(text As String) As Single
Dim result As String
Dim i As Long
For i = 1 To Len(text)
If Mid(text, i, 1) Like "[1-9.,]" Then result = result & Mid(text, i, 1)
Next
If Len(result) > 0 Then getNumbersFromString = CSng(s)
End Function
Hi I have the following code to search and the searched items are displayed in the listbox. I also have an update button that updates whatever new information you input in a textbox. the update box works fine but for some reason when multiple duplicated items are displayed in the listbox and i try to click the 2nd instance and try to update, it updates the original and not the 2nd instance. So, the first instance should update first instance item, and 2nd should update 2nd but right now, 1st is updating 1st instance, 2nd is updating 1st instance, 3rd is updating 1st instance - always updating the 1st instance. how can i fix this? this is the document: https://www.dropbox.com/s/36e9fmbf17wpa0l/example.xlsm
Public Sub Search_Click()
Dim Name As String
Dim f As Range
Dim s As Integer
Dim FirstAddress As String
Dim str() As String
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Master")
Name = surname.Value
With ws
Set f = .Range("A:A").Find(what:=Name, LookIn:=xlValues)
If Not f Is Nothing Then
With Me
firstname.Value = f.Offset(0, 1).Value
tod.Value = f.Offset(0, 2).Value
program.Value = f.Offset(0, 3).Value
email.Value = f.Offset(0, 4).Text
SetCheckBoxes f.Offset(0, 5) '<<< replaces code below
officenumber.Value = f.Offset(0, 6).Text
cellnumber.Value = f.Offset(0, 7).Text
r = f.Row
End With
findnext
FirstAddress = f.Address
Do
s = s + 1
Set f = Range("A:A").findnext(f)
Loop While Not f Is Nothing And f.Address <> FirstAddress
If s > 1 Then
Select Case MsgBox("There are " & s & " instances of " & Name, vbOKCancel Or vbExclamation Or vbDefaultButton1, "Multiple entries")
Case vbOK
findnext
Case vbCancel
End Select
End If
Else: MsgBox Name & "Not Listed"
End If
End With
End Sub
'-----------------------------------------------------------------------------
Sub findnext()
Dim Name As String
Dim f As Range
Dim ws As Worksheet
Dim s As Integer
Dim findnext As Range
Name = surname.Value
Me.ListBox1.Clear
Set ws = ThisWorkbook.Worksheets("Master")
With ws
Set f = .Cells(r, 1)
Set findnext = f
With ListBox1
Do
Debug.Print findnext.Address
Set findnext = Range("A:A").findnext(findnext)
.AddItem findnext.Value
.List(.ListCount - 1, 1) = findnext.Offset(0, 1).Value
.List(.ListCount - 1, 2) = findnext.Offset(0, 2).Value
.List(.ListCount - 1, 3) = findnext.Offset(0, 3).Value
.List(.ListCount - 1, 4) = findnext.Offset(0, 4).Value
.List(.ListCount - 1, 5) = findnext.Offset(0, 5).Value
.List(.ListCount - 1, 6) = findnext.Offset(0, 6).Value
.List(.ListCount - 1, 7) = findnext.Offset(0, 7).Value
.List(.ListCount - 1, 8) = findnext.Offset(0, 8).Value
Loop While findnext.Address <> f.Address
End With
End With
End Sub
'----------------------------------------------------------------------------
Public Sub update_Click()
MsgBox "Directorate has been updated!"
Dim Name As String
Dim f As Range
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Master")
With ws
Set f = .Cells(r, 1)
f.Value = surname.Value
f.Offset(0, 1).Value = firstname.Value
f.Offset(0, 2).Value = tod.Value
f.Offset(0, 3).Value = program.Value
f.Offset(0, 4).Value = email.Value
f.Offset(0, 5).Value = GetCheckBoxes
f.Offset(0, 6).Value = officenumber.Value
f.Offset(0, 7).Value = cellnumber.Value
End With
End Sub
The first obvious problem is r. This global is used as a temporary variable by Search_Click and as a master variable by update_Click.
Consider update_Click. Near the beginning we have:
Set ws = ThisWorkbook.Worksheets("Master")
With ws
Set f = .Cells(r, 1)
If you load the form, fill the fields and click Update then r will not have been initialised so with have the default value of zero.
It is very difficult to guess what this form is attempting to achieve. Most of the buttons do nothing. Of the two buttons that do work, neither is documented. I appreciate this form is under development but, if you are going to ask people to help debug it, you should make it easier to do so.
I assume the objective of update_Click is to add a new row to the bottom of worksheet "Master". If this assumption is true then I suggest the following:
Public Sub update_Click()
MsgBox "Directorate has been updated!"
Dim RowNext As Long
With ThisWorkbook.Worksheets("Master")
' There is no checking of the values entered by the user.
' I have assumed that the surname is present on the last used row.
' If this assumption is untrue, the new data will overwrite the row
' below the last row with a surname.
RowNext = .Cells(Rows.Count, "A").End(xlUp).Row + 1
.Cells(RowNext, "A").Value = surname.Value
.Cells(RowNext, "B").Value = firstname.Value
.Cells(RowNext, "C").Value = tod.Value
.Cells(RowNext, "D").Value = program.Value
.Cells(RowNext, "E").Value = email.Value
.Cells(RowNext, "F").Value = GetCheckBoxes
.Cells(RowNext, "G").Value = officenumber.Value
.Cells(RowNext, "H").Value = cellnumber.Value
End With
End Sub
If you confirm that I am on the right track, I have a look at Search_Click.
The code below is substantial different from yours. Partly this is because your code did not work while, to the extent I have tested it, mine does. But most of the changes are because I did not understand your code. As I worked through your code, I documented it, changed to meaningful names and implemented the effects I thought you were trying to achieve.
When you are creating code, it is important to remember that in six or twelve months you will be back to update it for new requirements. A little time spent making the code easy to understand as you write it can save hours when you need to maintain it. Name variables systematically so you immediately know what they are when you return. Explain what each subroutine and block of code it attempting to achieve so you can find the code you wish to update.
Firstly I have changed your form. I have made the form a little deeper and moved the listbox down. Above the listbox I have inserted a label which I have named lblMessage. This label spans the entire width of the form and is three lines deep. Most of your text is Tahoma 8. This label is Tahoma 10 and is coloured blue. I use it to tell the user what they are expected to do.
As the first line of the form's code I have added:
Option Explicit
Look this statement up to see why it should always be present.
You use Offsets to access the various columns in the worksheet. This can be a nightmare if the columns are every re-arranged. I have used constants:
Const ColMasterFamilyName As String = "A"
Const ColMasterGivenName As String = "B"
Const ColMasterTitle As String = "C"
Const ColMasterProgArea As String = "D"
Const ColMasterEMail As String = "E"
Const ColMasterStakeHolder As String = "F"
Const ColMasterOfficePhone As String = "G"
Const ColMasterCellPhone As String = "H"
This makes my statements much longer than yours but means that instead of 5, say, I have a name.
These constants are named using my system. "Col" says these are columns. "Master" says which worksheet they apply to. "FamilyName" says which column. In your code you use "surname" and "first name". I worked for too many years in an area where "surname" and "first name" were not "culturally sensitive". I am not asking you to like my system but you must have a system. I can look at code I wrote years ago and know what the variables are.
I have replaced your:
Public r As Long
with:
Dim RowEnteredName() As Long
I redimension this array for every select. If only a single row matches the entered name then it is dimensioned as ReDim RowEnteredName(1 To 1) and RowEnteredName(1) holds the row number. If Count rows match the entered name then it is dimensioned as ReDim RowEnteredName(0 To Count). RowEnteredName(0) is not used because it corresponds to the heading line while RowEnteredName(1 To Count) hold the row numbers for each repeat of the name.
I have added a form initialisation routine to prepare the form for use.
I have recoded your findnext as FillListBox because you cannot use keywords as the name for subroutines or variables.
There are routines in your code that I have commented out so that I know the code below is complete.
I hope all this makes sense.
Option Explicit
Const ColMasterFamilyName As String = "A"
Const ColMasterGivenName As String = "B"
Const ColMasterTitle As String = "C"
Const ColMasterProgArea As String = "D"
Const ColMasterEMail As String = "E"
Const ColMasterStakeHolder As String = "F"
Const ColMasterOfficePhone As String = "G"
Const ColMasterCellPhone As String = "H"
Dim RowEnteredName() As Long
Private Sub ListBox1_Click()
'pop listbox when more than one instances are prompted
'cliking the person's name will change the textboxes
'transfer the values to updateclick
Dim RowMasterCrnt As Long
If ListBox1.ListIndex = 0 Then
'Debug.Assert False
lblMessage.Caption = "You cannot select the heading row. Please select a person."
Exit Sub
End If
With ThisWorkbook.Worksheets("Master")
RowMasterCrnt = RowEnteredName(ListBox1.ListIndex)
ReDim RowEnteredName(1 To 1)
RowEnteredName(1) = RowMasterCrnt
surname.Value = .Cells(RowMasterCrnt, ColMasterFamilyName).Value
firstname.Value = .Cells(RowMasterCrnt, ColMasterGivenName).Value
tod.Value = .Cells(RowMasterCrnt, ColMasterTitle).Value
program.Value = .Cells(RowMasterCrnt, ColMasterProgArea).Value
email.Value = .Cells(RowMasterCrnt, ColMasterEMail).Value
Call SetCheckBoxes(.Cells(RowMasterCrnt, ColMasterStakeHolder).Value)
officenumber.Value = .Cells(RowMasterCrnt, ColMasterOfficePhone).Value
cellnumber.Value = .Cells(RowMasterCrnt, ColMasterCellPhone).Value
lblMessage.Caption = "Please change details as required then click [Update]. " & _
"If you have selected the wrong person, " & _
"please click [Select] to reselect."
update.Visible = True
End With
ListBox1.Visible = False ' Cannot use again because RowEnteredName changed
End Sub
Private Sub Search_Click()
' User should have entered a Family name before clicking Search.
If surname.Value = "" Then
Debug.Assert False ' Not tested
lblMessage.Caption = "Please enter a Family name or Surname"
Exit Sub
End If
Dim Name As String
Dim CellNameFirst As Range ' First cell, if any, holding family name
Dim Count As Long
Dim FirstAddress As String
lblMessage.Caption = ""
Name = surname.Value
With ThisWorkbook.Worksheets("Master")
' Look for entered family name in appropriate column
Set CellNameFirst = .Columns(ColMasterFamilyName).Find( _
what:=Name, after:=.Range(ColMasterFamilyName & "1"), _
lookat:=xlWhole, LookIn:=xlValues, _
SearchDirection:=xlNext, MatchCase:=False)
If Not CellNameFirst Is Nothing Then
' There is at least one person with the entered family name.
' Fill the listbox and make it visible if there is more than one person
' with the entered family name
'Debug.Assert False ' Not tested
Call FillListBox(CellNameFirst)
If ListBox1.Visible Then
' There is more than one person with the entered name
' Ensure update not available until selection made from list box
'Debug.Assert False ' Not tested
update.Visible = False
lblMessage.Caption = "Please click the required person within the listbox"
Exit Sub
Else
' Only one person with entered name
' Prepare the entry controls for updating by the user
'Debug.Assert False ' Not tested
ReDim RowEnteredName(1 To 1)
RowEnteredName(1) = CellNameFirst.Row ' Record row for selected family name
firstname.Value = .Cells(RowEnteredName(1), ColMasterGivenName).Value
tod.Value = .Cells(RowEnteredName(1), ColMasterTitle).Value
program.Value = .Cells(RowEnteredName(1), ColMasterProgArea).Value
email.Value = .Cells(RowEnteredName(1), ColMasterEMail).Value
Call SetCheckBoxes(.Cells(RowEnteredName(1), ColMasterStakeHolder).Value)
officenumber.Value = .Cells(RowEnteredName(1), ColMasterOfficePhone).Value
cellnumber.Value = .Cells(RowEnteredName(1), ColMasterCellPhone).Value
lblMessage.Caption = "Please change details as required then click Update"
update.Visible = True
End If
Else
Debug.Assert False ' Not tested
lblMessage.Caption = "No person found with that name. Please try another."
update.Visible = False
End If
End With
End Sub
Public Sub update_Click()
With ThisWorkbook.Worksheets("Master")
.Cells(RowEnteredName(1), "A").Value = surname.Value
.Cells(RowEnteredName(1), "B").Value = firstname.Value
.Cells(RowEnteredName(1), "C").Value = tod.Value
.Cells(RowEnteredName(1), "D").Value = program.Value
.Cells(RowEnteredName(1), "E").Value = email.Value
.Cells(RowEnteredName(1), "F").Value = GetCheckBoxes
.Cells(RowEnteredName(1), "G").Value = officenumber.Value
.Cells(RowEnteredName(1), "H").Value = cellnumber.Value
End With
' Clear controls ready for next select and update
surname.Value = ""
firstname.Value = ""
tod.Value = ""
program.Value = ""
email.Value = ""
Call SetCheckBoxes("")
officenumber.Value = ""
cellnumber.Value = ""
lblMessage.Caption = "Please enter the family name or surname of the " & _
"person whose details are to be updated then " & _
"click [Search]."
update.Visible = False
End Sub
Private Sub UserForm_Initialize()
' Set controls visible or invisible on initial entry to form.
' Update is not available until Search has been clicked and current
' details of a single person has been displayed.
update.Visible = False
' The listbox is only used if Search finds the entered name matches
' two or more people
ListBox1.Visible = False
' Search is the first button to be clicked and is always available
' as a means of cancelling the previous selection.
Search.Visible = True
' Not yet implemented
CommandButton1.Visible = False
CommandButton2.Visible = False
CommandButton3.Visible = False
CommandButton7.Visible = False
lblMessage.Caption = "Please enter the family name or surname of the " & _
"person whose details are to be updated then " & _
"click [Search]."
End Sub
Function ColCodeToNum(ColStg As String) As Integer
' Convert 1 or 2 character column identifiers to number.
' A -> 1; Z -> 26: AA -> 27; and so on
Dim lcColStg As String
lcColStg = LCase(ColStg)
ColCodeToNum = IIf(Len(ColStg) > 1, (Asc(Left(ColStg, 1)) - 64) * 26, 0) + _
Asc(Right(ColStg, 1)) - 64
End Function
Sub FillListBox(CellNameFirst As Range)
' CellNamefirst is the first, possibly only, cell for the
' family name entered by the user.
' Clear the listbox. If there is more than one person with the
' entered family name, make the listbox visible and fill it with
' every person with the same family name
Dim CellName As Range
Dim Count As Long
Dim ListBoxData() As String
Dim RowMasterCrnt As Long
Dim LbEntryCrnt As Long
Me.ListBox1.Clear
Set CellName = CellNameFirst
' Count number of rows with same family name as CellNameFirst
Count = 1
With ThisWorkbook.Worksheets("Master")
Do While True
Set CellName = .Columns(ColMasterFamilyName).findnext(CellName)
If CellName.Row = CellNameFirst.Row Then
'Debug.Assert False
Exit Do
End If
'Debug.Assert False
Count = Count + 1
Loop
End With
If Count = 1 Then
' Only one person has the entered family name
'Debug.Assert False
Me.ListBox1.Visible = False
Exit Sub
End If
'Debug.Assert False
Set CellName = CellNameFirst
ReDim ListBoxData(1 To 8, 0 To Count) ' Row 0 used for column headings
ReDim RowEnteredName(0 To Count)
LbEntryCrnt = 0
With ThisWorkbook.Worksheets("Master")
' Create column headings
ListBoxData(ColCodeToNum(ColMasterFamilyName), LbEntryCrnt) = _
.Cells(2, ColMasterFamilyName).Value
ListBoxData(ColCodeToNum(ColMasterGivenName), LbEntryCrnt) = _
.Cells(2, ColMasterGivenName).Value
ListBoxData(ColCodeToNum(ColMasterTitle), LbEntryCrnt) = _
.Cells(2, ColMasterTitle).Value
ListBoxData(ColCodeToNum(ColMasterProgArea), LbEntryCrnt) = _
.Cells(2, ColMasterProgArea).Value
ListBoxData(ColCodeToNum(ColMasterEMail), LbEntryCrnt) = _
.Cells(2, ColMasterEMail).Value
ListBoxData(ColCodeToNum(ColMasterStakeHolder), LbEntryCrnt) = _
.Cells(2, ColMasterStakeHolder).Value
ListBoxData(ColCodeToNum(ColMasterOfficePhone), LbEntryCrnt) = _
.Cells(2, ColMasterOfficePhone).Value
ListBoxData(ColCodeToNum(ColMasterCellPhone), LbEntryCrnt) = _
.Cells(2, ColMasterCellPhone).Value
LbEntryCrnt = LbEntryCrnt + 1
Do While True
' For each row with the same family name, add details to array
RowMasterCrnt = CellName.Row
ListBoxData(ColCodeToNum(ColMasterFamilyName), LbEntryCrnt) = _
.Cells(RowMasterCrnt, ColMasterFamilyName).Value
ListBoxData(ColCodeToNum(ColMasterGivenName), LbEntryCrnt) = _
.Cells(RowMasterCrnt, ColMasterGivenName).Value
ListBoxData(ColCodeToNum(ColMasterTitle), LbEntryCrnt) = _
.Cells(RowMasterCrnt, ColMasterTitle).Value
ListBoxData(ColCodeToNum(ColMasterProgArea), LbEntryCrnt) = _
.Cells(RowMasterCrnt, ColMasterProgArea).Value
ListBoxData(ColCodeToNum(ColMasterEMail), LbEntryCrnt) = _
.Cells(RowMasterCrnt, ColMasterEMail).Value
ListBoxData(ColCodeToNum(ColMasterStakeHolder), LbEntryCrnt) = _
.Cells(RowMasterCrnt, ColMasterStakeHolder).Value
ListBoxData(ColCodeToNum(ColMasterOfficePhone), LbEntryCrnt) = _
.Cells(RowMasterCrnt, ColMasterOfficePhone).Value
ListBoxData(ColCodeToNum(ColMasterCellPhone), LbEntryCrnt) = _
.Cells(RowMasterCrnt, ColMasterCellPhone).Value
RowEnteredName(LbEntryCrnt) = RowMasterCrnt
LbEntryCrnt = LbEntryCrnt + 1
Set CellName = .Columns(ColMasterFamilyName).findnext(CellName)
If CellName.Row = CellNameFirst.Row Then
Exit Do
End If
Loop
End With
Me.ListBox1.Column = ListBoxData ' Write array to listbox
ListBox1.Visible = True
End Sub
'Get the checked checkboxes as a space-separated string
Function GetCheckBoxes() As String
Dim arrStakeHolderAll() As Variant
Dim i As Long
Dim rv As String
'Debug.Assert False
arrStakeHolderAll = WhatCheckboxes()
rv = ""
For i = LBound(arrStakeHolderAll) To UBound(arrStakeHolderAll)
'Debug.Assert False
If Me.Controls(arrStakeHolderAll(i)).Value = True Then
'Debug.Assert False
rv = rv & IIf(Len(rv) > 0, " ", "") & arrStakeHolderAll(i)
End If
Next i
GetCheckBoxes = rv
End Function
Sub SetCheckBoxes(strList As String)
' Populate checkboxes from space-separated values in strList.
' Pass "" to just clear checkboxes
Dim arrStakeHolderAll() As Variant
Dim arrStakeHolderCrnt() As String
Dim i As Long
Dim tmp As String
'Debug.Assert False
PACT.Value = False
PrinceRupert.Value = False
WPM.Value = False
Montreal.Value = False
TET.Value = False
TC.Value = False
US.Value = False
Other.Value = False
arrStakeHolderAll = WhatCheckboxes()
If Len(strList) > 0 Then
'Debug.Assert False
arrStakeHolderCrnt = Split(strList, " ")
For i = LBound(arrStakeHolderCrnt) To UBound(arrStakeHolderCrnt)
'Debug.Assert False
tmp = Trim(arrStakeHolderCrnt(i))
If Not IsError(Application.Match(tmp, arrStakeHolderAll, 0)) Then
'Debug.Assert False
Me.Controls(tmp).Value = True
End If
Next i
End If
End Sub
'returns the name of all Stakeholder checkboxes
Function WhatCheckboxes() As Variant()
'Debug.Assert False
WhatCheckboxes = Array("PACT", "PrinceRupert", "WPM", _
"Montreal", "TET", "TC", "US", "Other")
End Function
i want to make a program that saves the text in textbox to excel file using loop because i want to insert multiple text to excel. i found codes but it only overwrites data in cells. i want the program to find the last row and insert new data to the next row. im stuck here, please someone help me how to do that in vb.net. here is my code:
Excel = CreateObject("Excel.Application")
Excel.screenupdating = True
Excel.Visible = True
'fieldnames
Dim xlWorkSheet As Object = Excel.workbooks.add
Excel.workbooks(1).worksheets(1).cells(1, 1).value = "TITLE"
Excel.workbooks(1).worksheets(1).cells(1, 2).value = "AUTHOR"
Excel.workbooks(1).worksheets(1).cells(1, 3).value = "EDITION"
Excel.workbooks(1).worksheets(1).cells(1, 4).value = "PUBLISHER"
Excel.workbooks(1).worksheets(1).cells(1, 5).value = "ISBN"
'i want to loop here the data in textboxes
Excel.workbooks(1).worksheets(1).cells(2, 1).value = txtTitle.Text
Excel.workbooks(1).worksheets(1).cells(2, 2).value = txtAuthor.Text
Excel.workbooks(1).worksheets(1).cells(2, 3).value = txtEdition.Text
Excel.workbooks(1).worksheets(1).cells(2, 4).value = txtPublisher.Text
Excel.workbooks(1).worksheets(1).cells(2, 5).value = txtISBN.Text
xlWorkSheet.SaveAs(FileName)
Excel.quit()
Excel = Nothing
you're going to need to dynamically set the value for the rowindex and the aplha column.
so something like this
dim currRow as integer = 0
Excel = CreateObject("Excel.Application")
Excel.screenupdating = True
Excel.Visible = True
'fieldnames
Dim xlWorkSheet As Object = Excel.workbooks.add
Excel.workbooks(1).worksheets(1).cells((currRow+1), 1).value = "TITLE"
Excel.workbooks(1).worksheets(1).cells((currRow+1), 2).value = "AUTHOR"
Excel.workbooks(1).worksheets(1).cells((currRow+1), 3).value = "EDITION"
Excel.workbooks(1).worksheets(1).cells((currRow+1), 4).value = "PUBLISHER"
Excel.workbooks(1).worksheets(1).cells((currRow+1), 5).value = "ISBN"
currRow += 1
for i as integer = currRow to 5
'i want to loop here the data in textboxes
Excel.workbooks(1).worksheets(1).cells((currRow + i), 1).value = txtTitle.Text
Excel.workbooks(1).worksheets(1).cells((currRow + i), 2).value = txtAuthor.Text
Excel.workbooks(1).worksheets(1).cells((currRow + i), 3).value = txtEdition.Text
Excel.workbooks(1).worksheets(1).cells((currRow + i), 4).value = txtPublisher.Text
Excel.workbooks(1).worksheets(1).cells((currRow + i), 5).value = txtISBN.Text
next
currRow += 1
xlWorkSheet.SaveAs(FileName)
Excel.quit()
Excel = Nothing
i don't know if this works but this is something to get you started.