kantian1
07-17-2008, 12:21 PM
Hi all,
in a nutshell I need to add multiple entries to a work sheet via a user form.
I have rows of week ending dates and columns of employee names.
I have included some code that searches through my worksheet which contains tables with filters. My current entry form consists of employee names and the week endings. So at the moment when I add an entry, I'll pick JOE BLOGS from a combo box and the weekending 16/04/2008 from a DTPicker.
The code searches the expanded tables for that name and that week ending date and adds a "RECEIVED" denoting that the time sheet has been received for that date and employee.
But then I thought why add one entry at a time when I could add as many employees as I wanted in one go by using a List box and ticking the employees I want to add for that particular weekending date, therefore adding multiple entries in one go?
Private Sub CommandButton1_Click()
Dim Sht As Worksheet
Dim rFound As Range, dFound As Range
Dim rRow As Long, dCol As Long
Dim Rng As Range
Dim OriginalSheet As String
OriginalSheet = ActiveSheet.Name
Application.ScreenUpdating = False
For Each Sht In Sheets
If Sht.Name = "Sheet1" Then GoTo Nxt
On Error Resume Next
Set dFound = Cells.Find(What:=Me.DTPicker1.Value, After:=Range("C22"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
On Error GoTo 0
If Not dFound Is Nothing Then
dCol = dFound.Column
Else
MsgBox "Date Not Found on Sheet " & Sht.Name
GoTo Nxt
End If
On Error Resume Next
Set rFound = Range("C" & dFound.Row - 1 & ":C" & Range("C" & Rows.Count).End(xlUp).Row).Find(What:=Me.ComboBox1.Value, _
After:=Range("C" & dFound.Row - 1), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
On Error GoTo 0
If Not rFound Is Nothing Then
rRow = rFound.Row
Else
MsgBox "Name Not Found On Sheet" & Sht.Name
GoTo Nxt
End If
Cells(rRow, dCol).Value = "RECEIVED"
Cells(rRow, dCol).Interior.ColorIndex = 10
Nxt:
Next Sht
Sheets(OriginalSheet).Activate
Application.ScreenUpdating = True
End Sub
Any thoughts?
in a nutshell I need to add multiple entries to a work sheet via a user form.
I have rows of week ending dates and columns of employee names.
I have included some code that searches through my worksheet which contains tables with filters. My current entry form consists of employee names and the week endings. So at the moment when I add an entry, I'll pick JOE BLOGS from a combo box and the weekending 16/04/2008 from a DTPicker.
The code searches the expanded tables for that name and that week ending date and adds a "RECEIVED" denoting that the time sheet has been received for that date and employee.
But then I thought why add one entry at a time when I could add as many employees as I wanted in one go by using a List box and ticking the employees I want to add for that particular weekending date, therefore adding multiple entries in one go?
Private Sub CommandButton1_Click()
Dim Sht As Worksheet
Dim rFound As Range, dFound As Range
Dim rRow As Long, dCol As Long
Dim Rng As Range
Dim OriginalSheet As String
OriginalSheet = ActiveSheet.Name
Application.ScreenUpdating = False
For Each Sht In Sheets
If Sht.Name = "Sheet1" Then GoTo Nxt
On Error Resume Next
Set dFound = Cells.Find(What:=Me.DTPicker1.Value, After:=Range("C22"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
On Error GoTo 0
If Not dFound Is Nothing Then
dCol = dFound.Column
Else
MsgBox "Date Not Found on Sheet " & Sht.Name
GoTo Nxt
End If
On Error Resume Next
Set rFound = Range("C" & dFound.Row - 1 & ":C" & Range("C" & Rows.Count).End(xlUp).Row).Find(What:=Me.ComboBox1.Value, _
After:=Range("C" & dFound.Row - 1), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
On Error GoTo 0
If Not rFound Is Nothing Then
rRow = rFound.Row
Else
MsgBox "Name Not Found On Sheet" & Sht.Name
GoTo Nxt
End If
Cells(rRow, dCol).Value = "RECEIVED"
Cells(rRow, dCol).Interior.ColorIndex = 10
Nxt:
Next Sht
Sheets(OriginalSheet).Activate
Application.ScreenUpdating = True
End Sub
Any thoughts?