Dear Dave Peterson and anyone who can help me,

I have been using the data entry form you have created for a long time and
you have no idea how much it has helped and worked for me. It is easy to use,
understand and effective.

The requirement I guess, grew and I was hoping for help to do a data entry
form for, say an Invoice or Journal (debit & credit). This means that with
one hit of the button, 2 or more entries will be saved into the database.
..

I will use an Invoice as an example.


Scenario:

What I want to do is to create an invoice that has fixed and multiple
entries in 1 transation.

The problem I am facing with the current VBA is that it saves one entry at a
time.

I am using the data entry form and repeating the Sub-Procedure 20 times for
one invoice if there are 20 items.

In short, D5 to D8 doesn't clear until I have finished entering the 20 items
(I changed the ClearContent D9 until D12).


Extracted from the VBA.
myCopy = "D5,D6,D7,D8,D9,D10,D11,D12"

Set inputWks = Worksheets("A-1")
Set historyWks = Worksheets("Dbase")

---------------------------------------------------------------------

Example of an Invoice.

--------------------------Sheet1 A-1----------------


----D5 = A123 (Invoice No.)
----D6 = 12-Jun-09 (Invoice Date.)
----D7 = G13 (Customer Code)
----D8 = John (Customer Name)



------D-----E--------F--G

10__ X1__Socks__5__$1
11__ X3__Shirt___8__$2
12__ Z2__Skirt___4__$3
- - - - - - -
- - - - - - -
- - - - - - -
20__ Z2__Skirt___8__$6


*D9 = Parts No.
*E9 = Parts Description
*F9 = Quantity
*G9 = Price


***Hoping to achieve this by saving only 1 time from A-1:

-------------------------Sheet2 Dbase-----------------


-----------------A------B----------C------D------E--------F-----G--H-


Row 01:__A123__12-Jun-09__G13__John___X1__Socks__5__$1
Row 02:__A123__12-Jun-09__G13__John___X3__Shirt___8__$2
Row 03:__A123__12-Jun-09__G13__John___Z2__Skirt___4__$3
- - - - - - - - - - - - - -
- - - - - - - - - - - - - -
- - - - - - - - - - - - - -
Row 20:__A123__12-Jun-09__G13__John___Z2__Skirt___8__$6



Thank you very much.

The VBA:


Option Explicit

Sub UpdateLogWorksheet()

Dim historyWks As Worksheet
Dim inputWks As Worksheet

Dim nextRow As Long
Dim oCol As Long

Dim myRng As Range
Dim myCopy As String
Dim myCell As Range

'cells to copy from Input sheet - some contain formulas
myCopy = "D5,D6,D7,D8,D9,D10,D11,D12,D13,D14,D37,D38,D39,D4 0"

Set inputWks = Worksheets("A-1")
Set historyWks = Worksheets("Dbase")

With historyWks
nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
End With

With inputWks
Set myRng = .Range(myCopy)

If Application.CountA(myRng) < myRng.Cells.Count Then
MsgBox "Fill up the Yellow Boxes!"
Range("D3").Select
Exit Sub
End If
End With

With historyWks
With .Cells(nextRow, "A")
'.Value = Now
'.NumberFormat = "mm/dd/yyyy hh:mm:ss"
'.Cells(nextRow, "B").Value = Application.UserName
oCol = 1 ' set to 1 instead of 3

For Each myCell In myRng.Cells
historyWks.Cells(nextRow, oCol).Value = myCell.Value
oCol = oCol + 1
Next myCell
End With
End With

'clear input cells that contain constants
' With inputWks
' On Error Resume Next
' With .Range(myCopy).Cells.SpecialCells(xlCellTypeConsta nts)
' .ClearContents
' Application.GoTo .Cells(1) ', Scroll:=True
' Range("B3").Select
' End With
' On Error GoTo 0
' End With

'Selective Clear Input Celss
With inputWks
On Error Resume Next
With Range("D14:D9").Cells.SpecialCells(xlCellTypeConst ants)
.ClearContents
Application.GoTo .Cells(1)
'Range("D6").Select
'ActiveWorkbook.Save
End With
On Error GoTo 0
End With


End Sub