Add data to rows consecutively

[moonbreakker]

Hello,

I am making a sheet and stuck half way..
In attached workbook, sheet 1 is not supposed to be touched.

In sheet 2 you can see, mechanic name, work done (free or paid) and amount.

I want a code and button in sheet 2.. I will enter data in only 1 row in sheet 2 and hit button, and it should get auto inserted in sheet 1 in next empty row (ie row 94 in sheet 1.)

I will select Mechanic in sheet 2, select work type, and enter amount.. These 3 details will be filled in sheet 1 , row 94.
Date should be auto =now() automatically..

Also is there a way to check if by mistake button is pressed 2 times that its a duplicate entry? I want to avoid duplicate entry and need some warning.

This seems very complicated, as i have googled a lot and i dont know vba..But i tried using conditional format and all.. but cant figure out a way..

[moonbreakker]

Sub PasteClient()

Dim ClientFile As String 'Holds client's file name
Dim CurRange As Range 'Holds current range selected

'In case of an error this will handle it gracefully and give you
'some information.
On Error GoTo ErrorHandler

'Turn screen updating off. You won't see the client file being updated.
Application.ScreenUpdating = False

'Make sure proper worksheet is active. This assumes the
'worksheet is named Sheet1. Adjust as required.
If ActiveCell.Worksheet.Name <> "MAIN" Then Exit Sub

'Make sure a cell in column A is selected. This assumes the client
'account number is in column A. Adjust as required.
If Left(ActiveCell.Address(False, False), 1) <> "A" Then Exit Sub

'Get the current range selected. These are cells in column A and
'are contiguous.
Set CurRange = Selection

'Iterate through each cell in selected range of client IDs in
'column A, selecting each client ID then copying client info,
'opening client file, pasting, closing client file.
For Each c In CurRange
  'Select the current client id in selected range
  c.Select

'Get the client's file name.
ClientFile = LABOUR.xlsm

'Select the client data to be posted. This assumes client data
'spans 6 cells
ActiveCell.Range("A1:D1").Copy

'Open the client file for posting. This assumes the path to the
'1000 client files is in the path "D:\R&D\CONFERENCE\CONFERENCE\". Adjust as required.
Workbooks.Open Filename:="D:\" & ClientFileD
'Assumes the client data will be posted on a worksheet named
'"Sheet1" in the client file just opened. Adjust as required.
Sheets("Sheet1").Select

'Position the cursor in the first cell in the client file. Assumes
'client data will be posted beginning in column A. Adjust as required.
Range("B5").Select

'Find the first empty cell where the current data can be posted.
Do While ActiveCell.Text > ""
  ActiveCell.Offset(1, 0).Select
    'Assumes your Excel sheets have 65536 rows. This prevents running
    'off the bottom of the worksheet and causing an error. Adjust as
'required.
    If ActiveCell.Row > 65536 Then Exit Sub
Loop

'Paste the client data into the client worksheet file.
ActiveSheet.Paste

'Cancels the copy mode. Client data can no longer be pasted any where else.
Application.CutCopyMode = False

'Save the client workbook and the posted data just pasted.
ActiveWorkbook.Save

'Close the client workbook.
ActiveWindow.Close

'Get next client data in range selected.
Next c

'Turn screen updating back on.
Application.ScreenUpdating = True

Exit Sub

ErrorHandler:

Select Case Err.Number
  Case Is = 1004 'Client file already open or client file does not exist.
'There may be
    'other things that will cause this error.
    'There are several ways to handle this error. I chose to inform the user
'then exit
    'this sub without any alteration to the client file.
    MsgBox "There is a problem with client file: " & ClientFile, vbOKOnly + vbInformation, "An error has occurred ..."
  Case Else 'Catches any unexpected errors.
    MsgBox "Error number " & Err.Number & " has occurred", vbOKOnly + vbInformation, "An error has occurred ..."

End Select
End Sub

[moonbreakker]

in attached book in sheet called "main" i need to copy b2 to e2 into sheet1 into last empty row (94)
Data duplication check is secondary.. i will use some funcion for it.

Thanks

[jaslake]

Hi moonbreakker

Assign this Code to your Button.

Option Explicit

Sub Update()
   Dim ws2          As Worksheet
   Dim ws1          As Worksheet
   Dim LR1          As Long

   Set ws1 = Sheets("Sheet1")
   Set ws2 = Sheets("Sheet2")
   Application.ScreenUpdating = False
   With ws1
      LR1 = .Range("C" & .Rows.Count).End(xlUp).Row + 1

      If IsEmpty(ws2.Cells(2, 1)) Or IsEmpty(ws2.Cells(2, 2)) Or IsEmpty(ws2.Cells(2, 3)) Then
         MsgBox "Data Incomplete"
         Exit Sub
      Else
         .Range("B" & LR1).Value = Now
         .Range("C" & LR1).Value = ws2.Cells(2, 1).Value
         .Range("D" & LR1).Value = ws2.Cells(2, 2).Value
         .Range("E" & LR1).Value = ws2.Cells(2, 3).Value

         ws2.Cells(2, 1).Value = ""
         ws2.Cells(2, 2).Value = ""
         ws2.Cells(2, 3).Value = ""

      End If

   End With
   Application.ScreenUpdating = True
End Sub

[moonbreakker]

Hello John. Thaks.

John, hmm sorry, but does not seem to work.
Can you do it in my file? I have uploaded my file

Last empty row of sheet1 should be updated.
In sheet2 row 2 should be copy pasted to last row in sheet 1...
And date =today()

Also if anything can be done to avoid duplicate entries.. (thats secondary)

Thanks.

[jaslake]

Hi moonbreakker

It won't work on the new File because the Structure is different from the original File.

Doing the Data Entry on a Worksheet I can think of no clean way to update the SR NO and Date Fields before the Button is clicked.

Because you want the SR NO and Date Fields auto-populated I'd suggest a User Form for your Data Entry.

Shall I pursue this approach?

[moonbreakker]

Worked with old sheet. I changed some parameters. Sr No not updating is OK with my. My purpose is solved. Thank you very much.