Option Explicit
'<<< Password to protect / unprotect sheets >>>
Const cPW = "123QWE"
'---------------------------------------------
Sub MainAdd()
' Add new form to Log
'---------------------------------------------
Dim Sh As Worksheet
Dim lSh As Worksheet
Dim lLrow As Long
Set Sh = ThisWorkbook.ActiveSheet
Set lSh = ThisWorkbook.Sheets(Left(ActiveSheet.Name, Len(ActiveSheet.Name) - 5) & " Log Sheet")
'determine the last row in the logs
lLrow = lSh.Cells(Rows.Count, "B").End(xlUp).Row + 1
'select the kind of form thats active according to the sheet name
Call Add_SD(Sh, lSh, lLrow)
'clear Data so the next form will be ready to fill
'Call ClearData
End Sub
'-------------------------------------------------------------------
Private Sub Add_SD(Sh As Worksheet, lSh As Worksheet, lLrow As Long)
'
'-------------------------------------------------------------------
Dim n As Long
'count how many lines the body items has. This is based on the bellow range. Chnage if you think
'another range should be used.
n = WorksheetFunction.CountA(Sh.Range("B21:B35"))
'<<<<I think there is no place for Data 9 in she SD log>>>>
'<<<<Again Entered by and entered cannot be associated from the form data>>>>
'>>>>>> Yes they can, see Footer section below <<<<<<<<<<
'header section
lSh.Cells(lLrow, "B").Resize(n, 1).Value = Sh.Cells(4, "J").Value
lSh.Cells(lLrow, "C").Resize(n, 1).Value = Sh.Cells(5, "J").Value
lSh.Cells(lLrow, "D").Resize(n, 1).Value = Sh.Cells(7, "J").Value
lSh.Cells(lLrow, "E").Resize(n, 1).Value = Sh.Cells(12, "D").Value
'main body section
lSh.Cells(lLrow, "F").Resize(n, 1).Value = Sh.Cells(21, "B").Resize(n, 1).Value
lSh.Cells(lLrow, "G").Resize(n, 1).Value = Sh.Cells(21, "D").Resize(n, 1).Value
lSh.Cells(lLrow, "H").Resize(n, 1).Value = Sh.Cells(21, "E").Resize(n, 1).Value
lSh.Cells(lLrow, "I").Resize(n, 1).Value = Sh.Cells(21, "F").Resize(n, 1).Value
lSh.Cells(lLrow, "J").Resize(n, 1).Value = Sh.Cells(21, "G").Resize(n, 1).Value
'footer section
' store submitted by
lSh.Cells(lLrow, "K").Resize(n, 1).Value = Sh.Cells(47, "C").Value
' store submitted date
lSh.Cells(lLrow, "L").Resize(n, 1).Value = Date
End Sub
'--------------------------------------------
Sub ClearData(Optional shSheet As Worksheet)
'
' Clears the input fields which have colouring
'---------------------------------------------
Dim rC As Range
If shSheet Is Nothing Then Set shSheet = ActiveSheet
Application.ScreenUpdating = False
UnProtectForm shSheet, False
For Each rC In shSheet.Range("A1:K60")
If rC.Interior.ThemeColor = xlThemeColorAccent3 Then
rC.Value = vbNullString
End If
Next
Application.ScreenUpdating = False
End Sub
'------------------------------------------------
Sub Update()
'
' passes sheet name to userform
'------------------------------------------------
Dim shMain As Worksheet, shLog As Worksheet
Dim lLrow As Long
Set shMain = ThisWorkbook.ActiveSheet
Set shLog = ThisWorkbook.Sheets(Left(shMain.Name, _
Len(shMain.Name) - 5) & " Log Sheet")
' pass log sheet name to userform and open form
With GetProjectForm 'name of the form
.SheetNm.Caption = shLog.Name
.Show
End With
End Sub
'--------------------------------------
Sub ProtectForm(wsF As Worksheet, bProtAll As Boolean)
'
' Protect sheet passed after checkin _
if all cells to be protected or only _
non-inputcells
'--------------------------------------
Dim rC As Range, rMA As Range
If bProtAll = True Then
For Each rC In wsF.Range("A1:K64")
If rC.Interior.ThemeColor = xlThemeColorAccent3 Then
' account for merged cells as these cannot be _
locked unlocked individually
Set rMA = rC.MergeArea
rMA.Locked = True
End If
Next
End If
wsF.Protect Password:=cPW
End Sub
'--------------------------------------
Sub UnProtectForm(wsF As Worksheet, bUnProtAll As Boolean)
'
' Unrotect sheet passed after checkin _
if all cells to be unprotected or only _
non-inputcells
'--------------------------------------
Dim rC As Range, rMA As Range
wsF.Unprotect Password:=cPW
For Each rC In wsF.Range("A1:K64")
If rC.Interior.ThemeColor = xlThemeColorAccent3 Then
' account for merged cells as these cannot be _
locked unlocked individually
Set rMA = rC.MergeArea
rMA.Locked = False
End If
Next
' if only unprotect entry fields
If bUnProtAll = False Then wsF.Unprotect Password:=cPW
End Sub
'-----------------------------------
Private Sub UnprotectAll()
'
' sub for file maintenance to unlock _
sheet totally
'-----------------------------------
UnProtectForm ActiveSheet, True
End SubOption Explicit
'----------------------------------
Private Sub ComboBox1_Change()
'
' macro run when combobox1 is changed. _
it will update te contents for _
combobox2
'----------------------------------
Dim shLog As Worksheet
Dim rCell As Range
Set shLog = Sheets(Me.SheetNm.Caption)
' now get the available revision numbers
' Fill the combobox2 with Rev nrs
With CreateObject("Scripting.Dictionary")
' a scripting dictionary allows only unique items, _
so you end up with a list ot put into combibox
For Each rCell In shLog.Range("C2", shLog.Cells(Rows.Count, "C").End(xlUp))
If Not .exists(rCell.Value) Then
If rCell.Offset(0, -1).Value = ComboBox1.Value Then
.Add rCell.Value, Nothing
' enter current row nr
Me.StartRow = rCell.Row
End If
End If
Next rCell
ComboBox2.List = .keys
' now show the last item of the list
With ComboBox2
.Value = .List(.ListCount - 1)
End With
End With
End Sub
'----------------------------------
Private Sub ComboBox2_Change()
'
' macro run when combobox2 is changed. _
it will update the contents for _
date and user fields
'----------------------------------
Dim shLog As Worksheet
Dim rFnd As Range
Dim l1st
Set shLog = Sheets(Me.SheetNm.Caption)
Set rFnd = shLog.Columns("B").Find(what:=ComboBox1.Value, _
after:=[B1], LookIn:=xlValues, lookat:=xlWhole, _
searchdirection:=xlNext)
l1st = rFnd.Row
Do While rFnd.Offset(0, 1) <> ComboBox2.Value
Set rFnd = shLog.Columns("B").FindNext(after:=rFnd)
If rFnd.Row = l1st Then Exit Do ' emergency end loop
Loop
' fill out the date and submitted by info
Me.StartRow.Caption = rFnd.Row
Me.TextBox1.Value = rFnd.Offset(0, 2)
Me.TextBox2.Value = rFnd.Offset(0, 9)
End Sub
'------------------------------------------
Private Sub CommandButton1_Click()
' OK button
' Fill out the selected details in the Form
'------------------------------------------
Dim wsFrm As Worksheet
Dim wsLog As Worksheet
Dim rFnd As Range, rOut As Range
Dim vArr As Variant
Set wsLog = Sheets(Me.SheetNm.Caption)
Set wsFrm = Sheets(Left(Me.SheetNm.Caption, _
InStr(1, Me.SheetNm.Caption, " ")) & "Form")
'clear form of calling sheet
ClearData wsFrm
ReDim vArr(1 To 1, 1 To 6) ' columns B:G
Set rFnd = wsLog.Cells(Me.StartRow, "B")
Set rOut = wsFrm.Cells(21, "B")
With rFnd
wsFrm.Range("J4") = .Offset(0, 0).Value
wsFrm.Range("J5") = .Offset(0, 1).Value
wsFrm.Range("J7") = .Offset(0, 2).Value
wsFrm.Range("D12") = .Offset(0, 3).Value
wsFrm.Range("C47") = .Offset(0, 9).Value
End With
Do While rFnd.Value = ComboBox1.Value And rFnd.Offset(0, 1).Value = ComboBox2.Value
With rFnd
vArr(1, 1) = .Offset(0, 4).Value
vArr(1, 3) = .Offset(0, 5).Value
vArr(1, 4) = .Offset(0, 6).Value
vArr(1, 5) = .Offset(0, 7).Value
vArr(1, 6) = .Offset(0, 8).Value
rOut.Resize(1, 6).Value = vArr
Set rOut = rOut.Offset(1, 0)
Set rFnd = .Offset(1, 0)
End With
Loop
' check if earlier revision, if so lock sheet
If ComboBox2.ListIndex <> ComboBox2.ListCount - 1 Then
' not last revision, protect
ProtectForm wsFrm, True
Else
UnProtectForm wsFrm, False
End If
Unload Me
End Sub
'-------------------------------------
Private Sub CommandButton2_Click()
' Cancel Button
'-------------------------------------
Unload Me
End Sub
'------------------------------------
Private Sub UserForm_Activate()
'
' macro run after form has been initialised. _
takes the sheet name and populates combobox1
'------------------------------------
Dim shLog As Worksheet
Dim rCell As Range
Set shLog = Sheets(Me.SheetNm.Caption)
' Fill the combobox with projects
With CreateObject("Scripting.Dictionary")
For Each rCell In shLog.Range("B2", shLog.Cells(Rows.Count, "B").End(xlUp))
If Not .exists(rCell.Value) Then
.Add rCell.Value, Nothing
End If
Next rCell
ComboBox1.List = .keys
' show last entry
ComboBox1.Value = ComboBox1.List(ComboBox1.ListCount - 1)
End With
End Sub
