VBA Column Formula Question

[zdodson]

Hello all,

I am trying to create a VBA userform that creates a composite score based on the data in this userform. The link is to a viewable google doc that has a screen shot of the VBA userform: https://docs.google.com/file/d/0B3NaddYem8bKN2ZPa1NXVWxIeXc/edit?usp=sharing

The formula is a bit complex. Below is the formula:

=IF(OR($B2="",$C2="",$D2=""),"",SUM(IFERROR(VLOOKUP($B2,$H$2:$K$87,4,FALSE),0),IFERROR(VLOOKUP($C2,$I$2:$K$102,3,FALSE),0),IFERROR(VLOOKUP($D2,$J$2:$K$92,2,TRUE),0)))

Basically, the formula checks to see if all three scores are available before generating a composite score. If all three values are not present, then it will return a blank cell.

Here is what the chart looks like:

[TABLE="width: 500"]
<tbody>[TR]
[TD="align: center"]Date[/TD]
[TD="align: center"]Pull-Ups[/TD]
[TD="align: center"]Crunches[/TD]
[TD="align: center"]3-Mile Run[/TD]
[TD="align: center"]PFT Score[/TD]
[/TR]
[TR]
[TD="align: center"]1-Mar-2013[/TD]
[TD="align: center"]15[/TD]
[TD="align: center"]100[/TD]
[TD="align: center"]0:19:10[/TD]
[TD="align: center"]269[/TD]
[/TR]
[TR]
[TD="align: center"]2-Mar-2013[/TD]
[TD="align: center"]16[/TD]
[TD="align: center"]98[/TD]
[TD="align: center"]0:19:00[/TD]
[TD="align: center"]273[/TD]
[/TR]
[TR]
[TD="align: center"]3-Mar-2013[/TD]
[TD="align: center"]20[/TD]
[TD="align: center"]98[/TD]
[TD="align: center"]0:18:10[/TD]
[TD="align: center"]297[/TD]
[/TR]
[TR]
[TD="align: center"]4-Mar-2013[/TD]
[TD="align: center"]20[/TD]
[TD="align: center"]99[/TD]
[TD="align: center"]0:18:09[/TD]
[TD="align: center"]299[/TD]
[/TR]
</tbody>[/TABLE]

Now for the question:

How do I create a formula so that when I hit my "Add Data" command button, it generates that composite score using the aforementioned formula? Basically, I need a VBA code that will find the first empty row in the data set, add the data, and then fill in the composite PFT score.

Thanks for your all's help!

Zack

 

[Andrew Poulsom]

I tested the code before I posted it and it worked as expected. If it's not working for you I'll need to know what you are putting in the TextBoxes. Also what's in your lookup table?

 

[zdodson]

I tested the code before I posted it and it worked as expected. If it's not working for you I'll need to know what you are putting in the TextBoxes. Also what's in your lookup table?

The date textbox returns today's date automatically with some code that I have put in. For the txtPullUps and txtCrunches textboxes, I am putting two to three digit numbers. For the txtMile, I was putting in a time (formatted as "h:mm:ss", but changed it to "hh:mm:ss").

Below is a copy of the workbook in which I am working:
https://docs.google.com/file/d/0B3NaddYem8bKcEhxY3NFbG1fUDQ/edit?usp=sharing

Also, the code is pasted below in case something doesn't work with the file.

Private Sub cmdAdd_Click()Dim ws As Worksheet
Dim r As Long
Set ws = Worksheets("PFT Database")


Sheets("PFT Database").Select


[COLOR=#00ff00]'Find first empty row in database[/COLOR]
iRow = ws.Cells(Rows.Count, 1) _
    .End(xlUp).Offset(1, 0).Row


[COLOR=#00ff00]'Check for date[/COLOR]
If Trim(Me.txtDate.Value) = "" Then
    Me.txtDate.Value.SetFocus
    MsgBox "Please enter a date", vbCritical
    Exit Sub
End If


[COLOR=#00ff00]'Check for pull-up amount[/COLOR]
If Trim(Me.txtPullUps.Value) = "" Then
    Me.txtPullUps.Value.SetFocus
    MsgBox "Please enter a time", vbCritical
    Exit Sub
End If


[COLOR=#00ff00]'Check for crunch number[/COLOR]
If Trim(Me.txtCrunches.Value) = "" Then
    Me.txtCrunches.Value.SetFocus
    MsgBox "Please select a category", vbCritical
    Exit Sub
End If


[COLOR=#00ff00]'Check mile time[/COLOR]
If Trim(Me.txtMile.Value) = "" Then
    Me.txtMile.Value.SetFocus
    MsgBox "Please enter the transaction amount", vbCritical
    Exit Sub
End If
[COLOR=#00ff00]
[/COLOR]
[COLOR=#00ff00]'Copy to the database[/COLOR]
ws.Cells(iRow, 1).Value = Me.txtDate.Value
ws.Cells(iRow, 2).Value = Me.txtPullUps.Value
ws.Cells(iRow, 3).Value = Me.txtCrunches.Value
ws.Cells(iRow, 4).Value = Me.txtMile.Value


[COLOR=#00ff00]'Clear userform[/COLOR]
Me.txtDate.Value = Format(Date, "Medium Date")
Me.txtPullUps.Value = ""
Me.txtCrunches.Value = ""
Me.txtMile.Value = ""


[COLOR=#00ff00]'Expand formula through column[/COLOR]
r = Range("A" & Rows.Count).End(xlUp).Row + 1
    Range("A" & r).Value = DateValue(txtDate.Text)
    Range("B" & r).Value = Val(txtPullUps.Text)
    Range("C" & r).Value = Val(txtCrunches.Text)
    Range("D" & r).Value = TimeValue(txtMile.Text)
    Range("E" & r).FormulaR1C1 = _
  "=IF(OR(RC2="""",RC3="""",RC4=""""),"""",SUM(IFERROR(VLOOKUP(RC2,R2C8:R87C11,4,FALSE),0),IFERROR(VLOOKUP(RC3,R2C9:R102C11,3,FALSE),0),IFERROR(VLOOKUP(RC4,R2C10:R92C11,2,TRUE),0)))"


End Sub

 

[zdodson]

I think I have figured it out, or at the very least have found an alternative to my dilemma. Below is the code (mark this thread as resolved):

Private Sub cmdAdd_Click()Dim ws As Worksheet
Dim lastrow As Long
Set ws = Worksheets("PFT Database")


Sheets("PFT Database").Select


'find first empty row in database
iRow = ws.Cells(Rows.Count, 1) _
    .End(xlUp).Offset(1, 0).Row


'check for date
If Trim(Me.txtDate.Value) = "" Then
    Me.txtDate.Value.SetFocus
    MsgBox "Please enter a date", vbCritical
    Exit Sub
End If


'check for time
If Trim(Me.txtPullUps.Value) = "" Then
    Me.txtPullUps.Value.SetFocus
    MsgBox "Please enter a time", vbCritical
    Exit Sub
End If


'check for category
If Trim(Me.txtCrunches.Value) = "" Then
    Me.txtCrunches.Value.SetFocus
    MsgBox "Please select a category", vbCritical
    Exit Sub
End If


'check for amount
If Trim(Me.txtMile.Value) = "" Then
    Me.txtMile.Value.SetFocus
    MsgBox "Please enter the transaction amount", vbCritical
    Exit Sub
End If


'copy to the database
ws.Cells(iRow, 1).Value = Me.txtDate.Value
ws.Cells(iRow, 2).Value = Me.txtPullUps.Value
ws.Cells(iRow, 3).Value = Me.txtCrunches.Value
ws.Cells(iRow, 4).Value = Me.txtMile.Value


'clear userform
Me.txtDate.Value = Format(Date, "dd-mmm-yyyy")
Me.txtPullUps.Value = ""
Me.txtCrunches.Value = ""
Me.txtMile.Value = ""


'Expand formula through column
Application.ScreenUpdating = False
lastrow = Range("A" & Rows.Count).End(xlUp).Row
Range("E2").Formula = "=IF(OR($B2="""",$C2="""",$D2=""""),"""",SUM(VLOOKUP($B2,$H$2:$K$87,4,FALSE),VLOOKUP($C2,$I$2:$K$102,3,FALSE),IF($D2<=$J$2,100,VLOOKUP($D2,$J$2:$K$92,2,TRUE))))"
Range("E2").AutoFill Destination:=Range("E2:E" & lastrow)
Application.ScreenUpdating = True
End Sub

 

[Andrew Poulsom]

The code I posted replaced this:

'Copy to the database
ws.Cells(iRow, 1).Value = Me.txtDate.Value
ws.Cells(iRow, 2).Value = Me.txtPullUps.Value
ws.Cells(iRow, 3).Value = Me.txtCrunches.Value
ws.Cells(iRow, 4).Value = Me.txtMile.Value

but I hadn't see your code so I couldn't amend it.