• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Help with a Data Entry form

D

DMA

New Member
Hi all and thanks in advance.

I'm trying to create a form, where, multiple users will need to enter in 3-4 data fields, similar to the chart seen here http://www.contextures.com/xlForm02.html#code

The data entered will be:

Name of place
Sub Name
Type of Record (can be drop-down of 3 choices)
Initials of Person Entering Data

The list of Name of Place/Sub-Name is rather large and the goal of creating this chart is to have users enter their data, and for excel to count how many are for each Place/Sub-Name of each specific Type of Record.

Is there a way to do this? Apologies if I'm unclear and thanks again.
 
Is question: "How do I count the permutations?" or is it "How do I create a form that accomplishes this?"
 
cdbauer1 said:
Is question: "How do I count the permutations?" or is it "How do I create a form that accomplishes this?"
Click to expand...


Thanks for your response and apologies for my ignorance, but I think my question is both.

I need a form that accomplishes the ability to have multiple users enter their data (Name/SubName/Type) into one sheet field, that is then sent to an output sheet that places it in the corresponding/appropriate Name/SubName row with Type as column and tallies it for each.

i hope this makes sense!
 
If it helps, as an example, the user would see this page

Name:
SubName:
Type of Record:

and would enter as a possibility

Name: ABC
SubName: XYZ
Type of Record: No Record

then this entry would fill in another sheet:
Name SubName No Record Record Other
ABC XYZ 1 0 0
DEF UVW 0 0 0
GHI RST 0 0 0

and would continue to tally as results came in
 
@DMA I know there has to be a more elegant way than what I've written below but try it out - it worked in the file I attached.

Code: 
Sub UpdateLogWorksheet()
'http://www.contextures.com/xlForm02.html
'code by Dave Peterson and modified by cdbauer1
'Make sure that your column headers on the PartsData tab go in the order of the Data Validation list and that they are identically named
    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 = "C2,C3,C4"

    Set inputWks = Worksheets("Input")
    Set historyWks = Worksheets("PartsData")

    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 "Please fill in all the cells!"
            Exit Sub
        End If
    End With

    With historyWks
        With .Cells(nextRow, "A")
            .Value = Now
            .NumberFormat = "mm/dd/yyyy hh:mm:ss"
        End With
        .Cells(nextRow, "B").Value = Application.UserName
        oCol = 3
        For Each myCell In myRng.Cells
            historyWks.Cells(nextRow, oCol).Value = myCell.Value
            If myCell.Value = "Record 1" Then
                historyWks.Cells(nextRow, oCol + 1).Value = 1
                historyWks.Cells(nextRow, oCol + 2).Value = 0
                historyWks.Cells(nextRow, oCol + 3).Value = 0
            End If
            If myCell.Value = "Record 2" Then
                historyWks.Cells(nextRow, oCol + 1).Value = 0
                historyWks.Cells(nextRow, oCol + 2).Value = 1
                historyWks.Cells(nextRow, oCol + 3).Value = 0
            End If
            If myCell.Value = "Record 3" Then
                historyWks.Cells(nextRow, oCol + 1).Value = 0
                historyWks.Cells(nextRow, oCol + 2).Value = 0
                historyWks.Cells(nextRow, oCol + 3).Value = 1
            End If
            oCol = oCol + 1
        Next myCell
       
    End With
   
    'clear input cells that contain constants
    With inputWks
      On Error Resume Next
         With .Range(myCopy).Cells.SpecialCells(xlCellTypeConstants)
              .ClearContents
              Application.Goto .Cells(1) ', Scroll:=True
         End With
      On Error GoTo 0
    End With

End Sub
 

Attachments

  • UpdateLog.xlsm
    23.1 KB · Views: 13
cdbauer1 I cannot thank you enough!

This is perfect. I edited the fields I needed and it works amazing!

I hope I can repay the favor.

Thanks again!

cdbauer1 said:
@DMA I know there has to be a more elegant way than what I've written below but try it out - it worked in the file I attached.

Code: 
Sub UpdateLogWorksheet()
'http://www.contextures.com/xlForm02.html
'code by Dave Peterson and modified by cdbauer1
'Make sure that your column headers on the PartsData tab go in the order of the Data Validation list and that they are identically named
    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 = "C2,C3,C4"

    Set inputWks = Worksheets("Input")
    Set historyWks = Worksheets("PartsData")

    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 "Please fill in all the cells!"
            Exit Sub
        End If
    End With

    With historyWks
        With .Cells(nextRow, "A")
            .Value = Now
            .NumberFormat = "mm/dd/yyyy hh:mm:ss"
        End With
        .Cells(nextRow, "B").Value = Application.UserName
        oCol = 3
        For Each myCell In myRng.Cells
            historyWks.Cells(nextRow, oCol).Value = myCell.Value
            If myCell.Value = "Record 1" Then
                historyWks.Cells(nextRow, oCol + 1).Value = 1
                historyWks.Cells(nextRow, oCol + 2).Value = 0
                historyWks.Cells(nextRow, oCol + 3).Value = 0
            End If
            If myCell.Value = "Record 2" Then
                historyWks.Cells(nextRow, oCol + 1).Value = 0
                historyWks.Cells(nextRow, oCol + 2).Value = 1
                historyWks.Cells(nextRow, oCol + 3).Value = 0
            End If
            If myCell.Value = "Record 3" Then
                historyWks.Cells(nextRow, oCol + 1).Value = 0
                historyWks.Cells(nextRow, oCol + 2).Value = 0
                historyWks.Cells(nextRow, oCol + 3).Value = 1
            End If
            oCol = oCol + 1
        Next myCell
      
    End With
  
    'clear input cells that contain constants
    With inputWks
      On Error Resume Next
         With .Range(myCopy).Cells.SpecialCells(xlCellTypeConstants)
              .ClearContents
              Application.Goto .Cells(1) ', Scroll:=True
         End With
      On Error GoTo 0
    End With

End Sub
Click to expand...
 
This is the excel I was referring to in my other thread.

Does anyone know how to add a quantity capacity to this?
 
DMA said:
This is the excel I was referring to in my other thread.
Does anyone know how to add a quantity capacity to this?
Click to expand...

Hi DMA!

Please help us, to help you..
I tracked your all post.. and doesn't found any excel file..

Is it possible to upload a sample file expected output..
 
Hi Debraj,

I attached the file, I basically want that quantity line to be an input line which will then correspond to the corresponding type in the "partsdata" tab.

Thanks!
 

Attachments

  • UpdateLog (2).xlsm
    20.3 KB · Views: 7
@DMA

Try The Below Code

Code: 
Sub UpdateLogWorksheet()
'http://www.contextures.com/xlForm02.html
'code by Dave Peterson and modified by cdbauer1
'Make sure that your column headers on the PartsData tab go in the order of the Data Validation list and that they are identically named
  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 = "C2,C3,C4,C5"

  Set inputWks = Worksheets("Input")
  Set historyWks = Worksheets("PartsData")

  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 "Please fill in all the cells!"
  Exit Sub
  End If
  End With

  With historyWks
  With .Cells(nextRow, "A")
  .Value = Now
  .NumberFormat = "mm/dd/yyyy hh:mm:ss"
  End With
  .Cells(nextRow, "B").Value = Application.UserName
  oCol = 3
  For Each myCell In myRng.Cells
  historyWks.Cells(nextRow, oCol).Value = myCell.Value
  If myCell.Value = "Record 1" Then
  historyWks.Cells(nextRow, oCol + 1).Value = 1
  historyWks.Cells(nextRow, oCol + 2).Value = 0
  historyWks.Cells(nextRow, oCol + 3).Value = 0
  End If
  If myCell.Value = "Record 2" Then
  historyWks.Cells(nextRow, oCol + 1).Value = 0
  historyWks.Cells(nextRow, oCol + 2).Value = 1
  historyWks.Cells(nextRow, oCol + 3).Value = 0
  End If
  If myCell.Value = "Record 3" Then
  historyWks.Cells(nextRow, oCol + 1).Value = 0
  historyWks.Cells(nextRow, oCol + 2).Value = 0
  historyWks.Cells(nextRow, oCol + 3).Value = 1
  End If
  If myCell.Value <> "" Then
  historyWks.Cells(nextRow, oCol + 1).Value = 0
  historyWks.Cells(nextRow, oCol + 2).Value = 0
  historyWks.Cells(nextRow, oCol + 3).Value = 1
  'historyWks.Cells(nextRow, oCol + 4).Value = 1
  End If
  oCol = oCol + 1
  Next myCell
   
  End With
   
  'clear input cells that contain constants
  With inputWks
  On Error Resume Next
  With .Range(myCopy).Cells.SpecialCells(xlCellTypeConstants)
  .ClearContents
  Application.GoTo .Cells(1) ', Scroll:=True
  End With
  On Error GoTo 0
  End With

End Sub

A Sample is attached

Thanks
 

Attachments

  • UpdateLog (2).xlsm
    20.5 KB · Views: 9
You must log in or register to reply here.
Back
Top