Being relatively new to userforms and some VBA code I have attempted to draft a macro for a command button.
The code in essence is supposed to do the following:
1) Once you select a scheme name (one) and list of staff (one or more)y
2) You press the command button and this inserts new rows in a table and adds the scheme to column b and staff names to column e. E.g. If you select Tom, Jane and Mark working on Job A then three rows would be added and column b will say Job A for al three rows and the staff names in column e.
3) The latter formulas do a vlookup to fill in the other columns based on columns b and e
4) Finally everything gets paste values
The problem is repeating the job in column b and the error message. If you don't select a staff member than the Boolean seems to work and the error message displays. However if you do not select a scheme then it crashes.
Any suggestions on refining the code are also welcome as it has been copied from various sources.
The code in essence is supposed to do the following:
1) Once you select a scheme name (one) and list of staff (one or more)y
2) You press the command button and this inserts new rows in a table and adds the scheme to column b and staff names to column e. E.g. If you select Tom, Jane and Mark working on Job A then three rows would be added and column b will say Job A for al three rows and the staff names in column e.
3) The latter formulas do a vlookup to fill in the other columns based on columns b and e
4) Finally everything gets paste values
The problem is repeating the job in column b and the error message. If you don't select a staff member than the Boolean seems to work and the error message displays. However if you do not select a scheme then it crashes.
Any suggestions on refining the code are also welcome as it has been copied from various sources.
Code:
Private Sub CommandButton3_Click()
Dim lItem As Long, lRows As Long, lCols As Long, mItem As Long, mRows As Long
Dim bSelected As Boolean
Dim cSelected As Boolean
Dim lColLoop As Long, lTransferRow As Long
Dim intIndex As Integer
Dim intCount As Integer
Dim k As Integer
Dim intRange As Range
'Pass row & column count to variables
'Less 1 as "Count" starts at zero
lRows = ListBox1.ListCount - 1
mRows = ListBox2.ListCount - 1
lCols = ListBox1.ColumnCount - 1
'Ensure they have at least 1 row selected
For lItem = 0 To lRows
'At least 1 row selected
If ListBox1.Selected(lItem) = True And ListBox2.Selected(mItem) = True Then
'Boolean flag
bSelected = True
'Exit for loop
Exit For
End If
Next
'shift cells down by number of staff memebers
With ListBox1
For intIndex = 0 To .ListCount - 1
If .Selected(intIndex) Then intCount = intCount + 1
Next
End With
Set intRange = Range("8:8")
rng = intCount
For k = 1 To rng
Rows(intRange.Row).Insert Shift:=xlDown, _
CopyOrigin:=xlFormatFromRightOrBelow
Next
'At least 1 row selected
If bSelected = True Then
With Sheet9.Range("e8", Sheet9.Cells(lRows + 1, 5 + lCols)) 'Transfer to range
For lItem = 0 To lRows
If ListBox1.Selected(lItem) = True Then 'Row selected
'Increment variable for row transfer range
lTransferRow = lTransferRow + 1
'Loop through columns of selected row
For lColLoop = 0 To lCols
'Transfer selected row to relevant row of transfer range
.Cells(lTransferRow, lColLoop + 1) = ListBox1.List(lItem, lColLoop)
'Uncheck selected row
ListBox1.Selected(lItem) = False
Next lColLoop
End If
Next
End With
Unload Me
Else ' NO listbox row chosen
MsgBox "No staff have been selected", vbCritical
End If
'Section to then use outputs from listbox and use vlookup to apply staff information
Dim StaffLastRow As Long
Dim ProjectLastRow As Long
Dim OutputLastRow As Long
Dim StaffSheet As Worksheet
Dim Projectsheet As Worksheet
Dim OutputSheet As Worksheet
'What are the names of our worksheets?
Set StaffSheet = Worksheets("Staff data")
Set Projectsheet = Worksheets("Project list")
Set OutputSheet = Worksheets("Sheet2")
'Determine last row of staff list
With StaffSheet
StaffLastRow = .Cells(.Rows.Count, "b").End(xlUp).Row
End With
With OutputSheet
'Determine last row in col E
OutputLastRow = .Cells(.Rows.Count, "E").End(xlUp).Row
'Apply our formula
.Range("f8:f" & OutputLastRow).Formula = _
"=VLOOKUP(e8,'" & StaffSheet.Name & "'!$b$2:$e$" & StaffLastRow & ",3,0)"
.Range("g8:g" & OutputLastRow).Formula = _
"=VLOOKUP(e8,'" & StaffSheet.Name & "'!$b$2:$e$" & StaffLastRow & ",2,0)"
.Range("h8:h" & OutputLastRow).Formula = _
"=VLOOKUP(e8,'" & StaffSheet.Name & "'!$b$2:$e$" & StaffLastRow & ",4,0)"
End With
'Determine last row of project list
With Projectsheet
ProjectLastRow = .Cells(.Rows.Count, "b").End(xlUp).Row
End With
With OutputSheet
'Determine last row in col E
OutputLastRow = .Cells(.Rows.Count, "E").End(xlUp).Row
'Apply our formula
.Range("c8:c" & OutputLastRow).Formula = _
"=VLOOKUP(b8,'" & Projectsheet.Name & "'!$a$2:$c$" & ProjectLastRow & ",2,0)"
.Range("d8:d" & OutputLastRow).Formula = _
"=VLOOKUP(b8,'" & Projectsheet.Name & "'!$a$2:$c$" & ProjectLastRow & ",3,0)"
End With
' Project Insert
Dim listItems As String, i As Long
With ListBox2
For i = 0 To .ListCount - 1
If .Selected(i) Then listItems = listItems & .List(i) & ", "
Next i
End With
Range("b8:b" & 7 + rng) = Left(listItems, Len(listItems) - 2)
'Turn all formulas into values
OutputSheet.UsedRange.Value = OutputSheet.UsedRange.Value
End Sub