Maybe something like this ?
Sub test()
dpt = Application.InputBox("Type Your Department")
Set c = Range("C:C").Find(dpt, lookat:=xlWhole)
If Not c Is Nothing Then
Set rg = Range(c, c.Offset(3, 0)).EntireRow
rg.Copy
rg.Insert Shift:=xlDown
Application.CutCopyMode = False
Range(c.Offset(-4, 1), c.Offset(-1, 1)).ClearContents
Set rgFormula = Range("C:C").Find("TOTAL TIME", lookat:=xlPart).Offset(0, 1)
rw = rgFormula.Row
j = 1
For i = 3 To rw Step 4
Cells(i - 1, 2).Value = j
j = j + 1
frm = frm + "d" + CStr(i)
If i < rw - 3 Then frm = frm + ","
Next i
rgFormula.Value = "=sum(" + frm + ")"
ActiveWindow.ScrollRow = c.Offset(-4, 1).Row
c.Offset(-4, 1).Activate
End If
End Sub
I am not sure that I understand correctly of what you want though.
I'm guessing that what you want is something like this :
IF any person from any department want to add data
THEN :
- ask the user to type what department he/she is from
- insert 4 rows above that any_department inputted by the user.
These four rows will contain :
1a. column B row X = a number
1b. column C row X = the name of the department inputted by the user
2. column C row X+1 = "Time in mins" text
3. column C row X+2 = "Purpose" text
4. column C row X+3 = "Leader" text
The code will update the number consecutively in column B,
and the code also update the formula in the cell next to the right of a cell contain text "TOTAL TIME"
So after the macro runs,
the user just fill the blank cell corresponding to the row on point-1b, point-2, point-3 and point-4.
2021-09-02_17-00-40.gif
Bookmarks