Transfer data dircety to database from spread sheet without having to re-enter into job entry spread sheet

A

AURA

New Member
Joined
Mar 4, 2009
Messages
6
xl 2003

I inherited a new job and the program tha goes with it. each week i have to re- enter 1500 values that are already on MY worksheet into a data entry (DE) worksheet, this sheet accepts only one entry ( employee name and one shift thay have worked) at a time and then this entry is submitted and appended to an ongoing (O) database from where it is accessed by other worksheets in the workbook ie GET PAYSLIPS .

i want to be able to copy paste MY worksheet data and thus append it to the (0) database without re-entering it all one by one into the DE worksheet


OR copy paste MY worksheet into the DE worksheet and send to (O) data base

THE PROBLEM
If i copy paste (special) into the O database from MY worksheet , the data is not recognised by the other worksheets in the workbook> it appears that it has to be sent from the DE worksheet

I am wondering if i am missing out some crucial entry by bypassing the TEDIOUS DATA ENTRY PAGE

NEXT 1500 ENTRIES DUE FRIDAY!!!

here are the programs

Sub AddNewEntryForSelectedEmployee()
' SaveJobData Macro
'


'check if saved before

Application.ScreenUpdating = False

'check that data exists
Range("v1").Select
If ActiveCell.Value = 0 Then
Range("b18").Select
Application.ScreenUpdating = True
MsgBox "No data is on the pay slip! Unable to save record"
GoTo endsub

End If


Range("k1").Select
If ActiveCell.Value = True Then ' true means already exists

Sheets("Job Database").Select
Range("A9").Select

Do

'error check first

ActiveCell.Offset(1, 0).Range("A1").Select
If ActiveCell.Value = "" Then

Application.ScreenUpdating = True

MsgBox "ERROR"
GoTo endsub
End If

'finds the matching record


Loop Until ActiveCell.Value = Range("n1").Value

Else ' else is that it is a new record

Sheets("Job Database").Select
Range("A9").Select

Do
ActiveCell.Offset(1, 0).Range("A1").Select

Loop Until ActiveCell.Value = ""

End If

'Copy SequenceID
Sheets("Job Entry").Select
Range("X1").Select
Selection.Copy
Sheets("Job Database").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Copy Name
Sheets("Job Entry").Select
Range("D10").Select
Selection.Copy
Sheets("Job Database").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Copy Emp Code
Sheets("Job Entry").Select
Range("D12").Select
Selection.Copy
Sheets("Job Database").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Copy Age
Sheets("Job Entry").Select
Range("D13").Select
Selection.Copy
Sheets("Job Database").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Copy Date of Birth
Sheets("Job Entry").Select
Range("D14").Select
Selection.Copy
Sheets("Job Database").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Copy Work Location
Sheets("Job Entry").Select
Range("D18").Select
Selection.Copy
Sheets("Job Database").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Copy Week starting
Sheets("Job Entry").Select
Range("H4").Select
Selection.Copy
Sheets("Job Database").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Copy JobDate
Sheets("Job Entry").Select
Range("B18").Select
Selection.Copy
Sheets("Job Database").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


'Copy Start Time
Sheets("Job Entry").Select
Range("e18").Select
Selection.Copy
Sheets("Job Database").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


'Copy Finish Time
Sheets("Job Entry").Select
Range("f18").Select
Selection.Copy
Sheets("Job Database").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


'Copy Public Holiday Flag
Sheets("Job Entry").Select
Range("c18").Select
Selection.Copy
Sheets("Job Database").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


'Copy Normal Time
Sheets("Job Entry").Select
Range("D21").Select
Selection.Copy
Sheets("Job Database").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Copy Shift Time
Sheets("Job Entry").Select
Range("D22").Select
Selection.Copy
Sheets("Job Database").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Copy Saturday Time
Sheets("Job Entry").Select
Range("D23").Select
Selection.Copy
Sheets("Job Database").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Copy Sunday Time
Sheets("Job Entry").Select
Range("D24").Select
Selection.Copy
Sheets("Job Database").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Copy Public Holiday Time
Sheets("Job Entry").Select
Range("D25").Select
Selection.Copy
Sheets("Job Database").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


Sheets("Job Entry").Select

Range("x2").Select
Selection.Copy
Range("x1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'go back to the top
Range("a1").Select


' Select cells b18 to f18 and clear the contents

'Checks for Employee Delete Flag
Range("L8").Select

If ActiveCell.Value = False Then
Range("D10").Select
Selection.ClearContents
End If

'Checks for Date Delete Flag
Range("L10").Select

If ActiveCell.Value = False Then
Range("B18").Select
Selection.ClearContents
End If

'Resets Public Holiday Flag to "N"
Range("C18").Select
ActiveCell.FormulaR1C1 = "N"

'Checks for Work Locations Delete Flag
Range("L12").Select

If ActiveCell.Value = False Then
Range("D18").Select
Selection.ClearContents
End If

'Checks for Start Time Delete Flag
Range("L14").Select

If ActiveCell.Value = False Then
Range("E18").Select
Selection.ClearContents
End If

'Checks for Finish Time Delete Flag
Range("L16").Select

If ActiveCell.Value = False Then
Range("F18").Select
Selection.ClearContents
End If


'go back to the first entry point

Range("B18").Select

MsgBox "Record Entered"

endsub:

Application.ScreenUpdating = True


End Sub




Sub GetPaySlipData()
'
' Copy In Job Details
'

'Delete old data first

Application.ScreenUpdating = False


Do

Range("A42").Select

If ActiveCell.Value <> "" Then

ActiveCell.Range("A1:H1").Select
Selection.Delete Shift:=xlUp

End If

Loop Until ActiveCell.Value = ""

'Find Matching Records
Range("A42").Select

Sheets("Job Database").Select
Range("b10").Select

Do

'check for name match
If ActiveCell.Value = Range("q2").Value Then
ActiveCell.Offset(0, 6).Range("A1").Select

'check for date match
If ActiveCell.Value >= Range("q3").Value Then
If ActiveCell.Value <= Range("q4").Value Then

ActiveCell.Offset(0, 9).Range("a1").Select
If ActiveCell.Value = "" Then
ActiveCell.Offset(0, -9).Range("a1").Select

'found a match!
'Copy In Data

Sheets("Pay Slip").Select

Sheets("Job Database").Select
ActiveCell.Offset(0, -2).Range("A1").Select
Selection.Copy
Sheets("Pay Slip").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

ActiveCell.Offset(0, 2).Range("A1").Select
Sheets("Job Database").Select
ActiveCell.Offset(0, 2).Range("A1").Select
Selection.Copy
Sheets("Pay Slip").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Job Database").Select
ActiveCell.Offset(0, 3).Range("A1").Select
Selection.Copy
Sheets("Pay Slip").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Job Database").Select
ActiveCell.Offset(0, -2).Range("A1").Select
Selection.Copy
Sheets("Pay Slip").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Job Database").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.Copy
Sheets("Pay Slip").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'this puts in the control number used to reference taken records
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Job Database").Select
ActiveCell.Offset(0, -9).Range("A1").Select
Selection.Copy
Sheets("Pay Slip").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

ActiveCell.Offset(1, -6).Range("A1").Select
Sheets("Job Database").Select
ActiveCell.Offset(0, 7).Range("A1").Select

Else
ActiveCell.Offset(0, -9).Range("a1").Select

End If

End If
End If

'Move cursor back to Name for checking
ActiveCell.Offset(0, -6).Range("A1").Select

End If

ActiveCell.Offset(1, 0).Range("A1").Select

Loop Until ActiveCell.Value = ""

'Adjust Formats

Sheets("Pay Slip").Select
Range("a41").Select
Do
ActiveCell.Offset(1, 0).Range("A1").Select
If ActiveCell <> "" Then
ActiveCell.Offset(-1, 0).Range("A1:h1").Select
Selection.Copy
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

End If


Loop Until ActiveCell.Value = ""

'Add calculation formulas for hours

'These are the background formulas used to work out what the total hours are for each entry

Range("J42").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-5]>='Job Entry'!R1C25,0,RC[-4]-RC[-5]-RC[1])"

Range("K42").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-5]>='Job Entry'!R1C25,IF(RC[-6]>='Job Entry'!R1C25,RC[-5]-RC[-6],RC[-5]-'Job Entry'!R1C25),0)"

Range("L42").Select
ActiveCell.FormulaR1C1 = "=RC[-2]+RC[-1]"

Range("M42").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-10]="""","""",IF(WEEKDAY(RC[-10],1)=1,""SUNDAY"",IF(WEEKDAY(RC[-10],1)=2,""MONDAY"",IF(WEEKDAY(RC[-10],1)=3,""TUESDAY"",IF(WEEKDAY(RC[-10],1)=4,""WEDNESDAY"",IF(WEEKDAY(RC[-10],1)=5,""THURSDAY"",IF(WEEKDAY(RC[-10],1)=6,""FRIDAY"",""SATURDAY"")))))))"

'Copies down the formulas for 60 records

Range("J42:M42").Select
Selection.Copy
Range("J43:J100").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'These formulas calculate the hour types
Range("C24").Select
ActiveCell.FormulaR1C1 = _
"=(SUMPRODUCT(--(R[18]C[1]:R[77]C[1]<>""Y"")*--(R[18]C[10]:R[77]C[10]<>""SATURDAY"")*--(R[18]C[10]:R[77]C[10]<>""SUNDAY"")*(R[18]C[7]:R[77]C[7])))*24"

Range("C25").Select
ActiveCell.FormulaR1C1 = _
"=(SUMPRODUCT(--(R[17]C[1]:R[76]C[1]<>""Y"")*--(R[17]C[10]:R[76]C[10]<>""SATURDAY"")*--(R[17]C[10]:R[76]C[10]<>""SUNDAY"")*(R[17]C[8]:R[76]C[8])))*24"

Range("C26").Select
ActiveCell.FormulaR1C1 = _
"=(SUMPRODUCT(--(R[16]C[10]:R[75]C[10]=""SATURDAY"")*--(R[16]C[1]:R[75]C[1]<>""Y"")*(R[16]C[9]:R[75]C[9])))*24"

Range("C27").Select
ActiveCell.FormulaR1C1 = _
"=(SUMPRODUCT(--(R[15]C[10]:R[74]C[10]=""SUNDAY"")*--(R[15]C[1]:R[74]C[1]<>""Y"")*(R[15]C[9]:R[74]C[9])))*24"

Range("C28").Select
ActiveCell.FormulaR1C1 = _
"=(SUMPRODUCT(--(R[14]C[1]:R[73]C[1]=""Y"")*(R[14]C[9]:R[73]C[9])))*24"

'Go to the top!
Range("A1").Select

Application.ScreenUpdating = True
Application.CutCopyMode = False


End Sub
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
You must log in or register to reply here.

Similar threads

S
  • Solved
VBA macro-is there a faster way to copy-paste special?
2
Replies
11
Views
1K
simbah
S
J
  • Question
Repaired Part: /xl/worksheet/sheet31.xml-Part
Replies
1
Views
141
RoryA
RoryA
A
  • Solved
Edit the code for all data
Replies
3
Views
69
kvsrinivasamurthy
K
D
  • Solved
Loop through multiple sheets and create Graph in each sheet
Replies
3
Views
116
Micron
M
A
  • Question
How to avoid copying data if cells are blank
Replies
1
Views
101
iggydarsa
iggydarsa

Forum statistics

Threads
1,191,123
Messages
5,984,775
Members
439,910
Latest member
Flyingjoblo

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top