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 Sub