How do I add additional input fields to the right of the Order Id, Supposedly it has a macros that needs to be edited, but I cant find.

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:

  • 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.
Now I have gone through the macros and I can not find a sel record links sheet, i have searched each of the macros for inputA, InputB, and I can not find them.

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 = True

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.
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
62,383
Office Version
  1. 365
Platform
  1. Windows
Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: Contextures refers to a macros to add imput areas, Unable to find this macro to add imput
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.
 

Forum statistics

Threads
1,141,311
Messages
5,705,680
Members
421,405
Latest member
buster015

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