Born2dive00
New Member
- Joined
- Nov 15, 2019
- Messages
- 4
Hello everyone, so I have downloaded this very nice data entry form from Excel Data Entry and Update Form. It will do exactly what I need IF i can add additional imput areas to the right of the parts order data entry. Now the contexture website says to add additional imput areas to do this.
If you need more input areas, follow the steps below, and use the setup and naming structure for the existing input areas as a guide. In this example, a third input area is being added:
Is there any VBA gurus out there that can help me please.
does anyone see how this is to work.
How do i upload a excel spread sheet to this site so you can see what is the problem.
If you need more input areas, follow the steps below, and use the setup and naming structure for the existing input areas as a guide. In this example, a third input area is being added:
- Input sheet: Create new input cells, and name that range as InputC
- PartsData sheet: Add columns for new fields
- Input Links sheet, add cells in row 4, copy formulas across in rows 5, 6, 9
- Adjust the InputCopy named range to include the new formula cells
- SelRecordLinks sheet, set up formulas for new input range (use same cells as on Input sheet)
- Name the value cells as SelValC
- In the code (Alt+F11), add lines for new input area (InputC), wherever there is code for InputA and InputB. To find them, press Ctrl+F, to open the Find window, Find: InputA, Search: Current Project. Then, copy the line for InputB, paste, and change to InputC.
Is there any VBA gurus out there that can help me please.
VBA Code:
Option Explicit
' Developed by Contextures Inc.
' www.contextures.com
Private Sub Worksheet_Change(ByVal Target As Range)
Dim historyWks As Worksheet
Dim inputWks As Worksheet
Dim rngA As Range
Dim lRec As Long
Dim lRecRow As Long
Dim lLastRec As Long
Dim lastRow As Long
Set rngA = ActiveCell
If Target.Address = Me.Range("CurrRec").Address _
Or Target.Address = Me.Range("OrderSel").Address Then
Application.EnableEvents = False
If Target.Address = Me.Range("OrderSel").Address Then
Me.Range("CurrRec").Value = Me.Range("SelRec").Value
End If
Set inputWks = Worksheets("Input")
Set historyWks = Worksheets("PartsData")
With historyWks
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row - 1
lLastRec = lastRow - 1
End With
With inputWks
lRec = .Range("CurrRec").Value
If lRec > 0 And lRec <= lLastRec Then
lRecRow = lRec + 1
historyWks.Range(historyWks.Cells(lRecRow, 3), historyWks.Cells(lRecRow, 6)).Copy
.Range("D5").PasteSpecial Paste:=xlPasteValues, Transpose:=True
rngA.Select
End If
End With
Application.EnableEvents = True
End If
End Sub
VBA Code:
Option Explicit
' Developed by Contextures Inc.
' www.contextures.com
Sub StartNewRecord()
Dim inputWks As Worksheet
Dim listWks As Worksheet
Dim rngClear As Range
Dim rngNext As Range
Dim rngID As Range
Set inputWks = Worksheets("Input")
Set listWks = Worksheets("LookupLists")
Set rngClear = inputWks.Range("DataEntryClear")
Set rngID = inputWks.Range("IDNum")
Set rngNext = listWks.Range("NextID")
rngClear.ClearContents
rngID.Value = rngNext.Value
inputWks.Activate
rngID.Offset(1, 0).Activate
End Sub
Sub UpdateLogWorksheet()
Dim historyWks As Worksheet
Dim inputWks As Worksheet
Dim nextRow As Long
Dim oCol As Long
Dim myCopy As Range
Dim myTest As Range
Dim lRsp As Long
Set inputWks = Worksheets("Input")
Set historyWks = Worksheets("PartsData")
oCol = 3 'order info is pasted on data sheet, starting in this column
'check for duplicate order ID in database
If inputWks.Range("CheckID") = True Then
lRsp = MsgBox("Order ID already in database. Update record?", vbQuestion + vbYesNo, "Duplicate ID")
If lRsp = vbYes Then
UpdateLogRecord
Else
MsgBox "Please change Order ID to a unique number."
End If
Else
'cells to copy from Input sheet - some contain formulas
Set myCopy = inputWks.Range("OrderEntry")
With historyWks
nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
End With
With inputWks
'mandatory fields are tested in hidden column
Set myTest = myCopy.Offset(0, 2)
If Application.Count(myTest) > 0 Then
MsgBox "Please fill in all the cells!"
Exit Sub
End If
End With
With historyWks
'enter date and time stamp in record
With .Cells(nextRow, "A")
.Value = Now
.NumberFormat = "mm/dd/yyyy hh:mm:ss"
End With
'enter user name in column B
.Cells(nextRow, "B").Value = Application.UserName
'copy the order data and paste onto data sheet
myCopy.Copy
.Cells(nextRow, 3).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
End With
'clear input cells that contain constants
With inputWks
On Error Resume Next
With myCopy.Cells.SpecialCells(xlCellTypeConstants)
.ClearContents
Application.GoTo .Cells(1) ', Scroll:=True
End With
On Error GoTo 0
End With
End If
End Sub
Sub UpdateLogRecord()
Dim historyWks As Worksheet
Dim inputWks As Worksheet
Dim lRec As Long
Dim oCol As Long
Dim lRecRow As Long
Dim myCopy As Range
Dim myTest As Range
Dim lRsp As Long
Set inputWks = Worksheets("Input")
Set historyWks = Worksheets("PartsData")
oCol = 3 'order info is pasted on data sheet, starting in this column
'check for duplicate order ID in database
If inputWks.Range("CheckID") = False Then
lRsp = MsgBox("Order ID not in database. Add record?", vbQuestion + vbYesNo, "New Order ID")
If lRsp = vbYes Then
UpdateLogWorksheet
Else
MsgBox "Please select Order ID that is in the database."
End If
Else
'cells to copy from Input sheet - some contain formulas
Set myCopy = inputWks.Range("OrderEntry")
lRec = inputWks.Range("CurrRec").Value
lRecRow = lRec + 1
With inputWks
Set myTest = myCopy.Offset(0, 2)
If Application.Count(myTest) > 0 Then
MsgBox "Please fill in all the cells!"
Exit Sub
End If
End With
With historyWks
With .Cells(lRecRow, "A")
.Value = Now
.NumberFormat = "mm/dd/yyyy hh:mm:ss"
End With
.Cells(lRecRow, "B").Value = Application.UserName
oCol = 3
myCopy.Copy
.Cells(lRecRow, 3).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
End With
'clear input cells that contain constants
With inputWks
On Error Resume Next
With myCopy.Cells.SpecialCells(xlCellTypeConstants)
.ClearContents
Application.GoTo .Cells(1) ', Scroll:=True
End With
On Error GoTo 0
If .Range("ShowMsg").Value = "Yes" Then
MsgBox "Database has been updated."
End If
End With
End If
End Sub
Sub DeleteLogRecord()
Dim historyWks As Worksheet
Dim inputWks As Worksheet
Dim lRec As Long
' Dim oCol As Long
Dim lRecRow As Long
Dim lDel As Long
Dim strOrder As String
Dim myCopy As Range
Dim myTest As Range
Set inputWks = Worksheets("Input")
Set historyWks = Worksheets("PartsData")
strOrder = inputWks.Range("OrderSel").Value
lRec = inputWks.Range("CurrRec").Value
lRecRow = lRec + 1
'cells to clear after deleting record
Set myCopy = inputWks.Range("OrderEntry")
lDel = MsgBox("Delete record " & strOrder & "?", vbCritical + vbYesNo, "Delete record")
If lDel = vbYes Then
With historyWks
With .Cells(lRecRow, "A")
Application.DisplayAlerts = False
.EntireRow.Delete
Application.DisplayAlerts = True
End With
End With
'clear input cells that contain constants
With inputWks
On Error Resume Next
With myCopy.Cells.SpecialCells(xlCellTypeConstants)
.ClearContents
Application.GoTo .Cells(1) ', Scroll:=True
End With
On Error GoTo 0
End With
Else
MsgBox "Cancelled"
End If
End Sub
VBA Code:
Option Explicit
' Developed by Contextures Inc.
' www.contextures.com
Sub GoInventory()
On Error Resume Next
Worksheets("PartsData").Activate
End Sub
Sub GoInput()
On Error Resume Next
Worksheets("Input").Activate
End Sub
VBA Code:
Option Explicit
' Developed by Contextures Inc.
' www.contextures.com
Sub ViewLogFirst()
Dim historyWks As Worksheet
Dim inputWks As Worksheet
Dim rngA As Range
Dim lRec As Long
Dim lRecRow As Long
Dim lLastRec As Long
Dim lastRow As Long
Application.EnableEvents = False
Set inputWks = Worksheets("Input")
Set historyWks = Worksheets("PartsData")
Set rngA = ActiveCell
With historyWks
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row - 1
lLastRec = lastRow - 1
End With
With inputWks
.Range("CurrRec").Value = 1
lRec = .Range("CurrRec").Value
lRecRow = lRec + 1
historyWks.Range(historyWks.Cells(lRecRow, 3), historyWks.Cells(lRecRow, 6)).Copy
.Range("D5").PasteSpecial Paste:=xlPasteValues, Transpose:=True
inputWks.Range("OrderSel").Value = .Range("D5").Value
rngA.Select
End With
Application.EnableEvents = True
End Sub
Sub ViewLogUp()
Dim historyWks As Worksheet
Dim inputWks As Worksheet
Dim rngA As Range
Dim lRec As Long
Dim lRecRow As Long
Dim lLastRec As Long
Dim lastRow As Long
Application.EnableEvents = False
Set inputWks = Worksheets("Input")
Set historyWks = Worksheets("PartsData")
Set rngA = ActiveCell
With historyWks
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row - 1
lLastRec = lastRow - 1
End With
With inputWks
lRec = .Range("CurrRec").Value
If lRec > 1 Then
.Range("CurrRec").Value = lRec - 1
lRec = .Range("CurrRec").Value
lRecRow = lRec + 1
historyWks.Range(historyWks.Cells(lRecRow, 3), historyWks.Cells(lRecRow, 6)).Copy
.Range("D5").PasteSpecial Paste:=xlPasteValues, Transpose:=True
inputWks.Range("OrderSel").Value = .Range("D5").Value
rngA.Select
End If
End With
Application.EnableEvents = True
End Sub
Sub ViewLogDown()
Dim historyWks As Worksheet
Dim inputWks As Worksheet
Dim rngA As Range
Dim lRec As Long
Dim lRecRow As Long
Dim lLastRec As Long
Dim lastRow As Long
Application.EnableEvents = False
Set inputWks = Worksheets("Input")
Set historyWks = Worksheets("PartsData")
Set rngA = ActiveCell
With historyWks
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row - 1
lLastRec = lastRow - 1
End With
With inputWks
lRec = .Range("CurrRec").Value
If lRec < lLastRec Then
.Range("CurrRec").Value = lRec + 1
lRec = .Range("CurrRec").Value
lRecRow = lRec + 1
historyWks.Range(historyWks.Cells(lRecRow, 3), historyWks.Cells(lRecRow, 6)).Copy
.Range("D5").PasteSpecial Paste:=xlPasteValues, Transpose:=True
inputWks.Range("OrderSel").Value = .Range("D5").Value
rngA.Select
End If
End With
Application.EnableEvents = True
End Sub
Sub ViewLogLast()
Dim historyWks As Worksheet
Dim inputWks As Worksheet
Dim rngA As Range
Dim lRec As Long
Dim lRecRow As Long
Dim lLastRec As Long
Dim lastRow As Long
Application.EnableEvents = False
Set inputWks = Worksheets("Input")
Set historyWks = Worksheets("PartsData")
Set rngA = ActiveCell
With historyWks
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row - 1
lLastRec = lastRow - 1
End With
With inputWks
.Range("CurrRec").Value = lLastRec
lRec = .Range("CurrRec").Value
lRecRow = lRec + 1
historyWks.Range(historyWks.Cells(lRecRow, 3), historyWks.Cells(lRecRow, 6)).Copy
.Range("D5").PasteSpecial Paste:=xlPasteValues, Transpose:=True
inputWks.Range("OrderSel").Value = .Range("D5").Value
rngA.Select
End With
Application.EnableEvents = Truedoes anyone see how this is to work.
How do i upload a excel spread sheet to this site so you can see what is the problem.
