• 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.

VBA + 2 Variables (Quantity + Type)

DMA

New Member
Hey all,

first off thanks so much for all your help in the past.

I've created (from contextures "partsdata" http://www.contextures.com/xlForm02.html) my own form which has a data entry sheet with:

Name
Subname
Type (3 choices from drop-down)
Quantity (1-100)

The name and subname are fine, it's when I put in the Type and Quantity it gets screwy.

I took out the quantity originally because I thought it would not be needed, but now, I need it to place the quantity of the specific Type in the corresponding column. With the current code, it is only copying the Quantity to the first Type column in the partsdata page. I'd like it to copy the Type + Quantity to the appropriate Type column (e.g. if I put in Type 2/40, I want it to put in 40 in the type 2 column)

I'll post the VBA code i have below where C7 = Quantity and C6 = Type of record
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,C6,C7"

    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"
        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 = "No Record" 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" 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 Redacted" 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
 
Last edited by a moderator:
Back
Top