View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.misc
Dave Peterson Dave Peterson is offline
external usenet poster
 
Posts: 35,218
Default Data Entry Form - Execute if value is not 0

I'm not sure what you're doing, but maybe...

Option Explicit
Sub UpdateDataWorksheet()

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
Dim HowManyTimesCell As Range

'cells to copy from Input sheet - some contain formulas
myCopy = "K5,L5,M5,N5,O5,P5,Q5,R5,S5"

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

With historyWks
nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
End With

With inputWks
Set HowManyTimesCell = .Range("J5")
Set myRng = .Range(myCopy)
If Application.CountA(.Range("K5:S5")) < .Range("T5").Value Then
Exit Sub
End If
End With

If IsNumeric(HowManyTimesCell.Value) = False Then
MsgBox "J5 not numeric"
Exit Sub
Else
If HowManyTimesCell.Value < 1 Then
MsgBox "J5 already too small"
Exit Sub
Else
'some sanity check
If HowManyTimesCell.Value 10 Then
MsgBox "J5 too large"
Exit Sub
End If
End If
End If

Do
With historyWks
With .Cells(nextRow, "A")
oCol = 1
For Each myCell In myRng.Cells
historyWks.Cells(nextRow, oCol).Value = myCell.Value
oCol = oCol + 1
Next myCell
End With
End With

With HowManyTimesCell
'subtract one from the cell
.Value = .Value - 1
If Int(.Value) < 1 Then
Exit Do
End If
End With
Loop

End Sub

ps. Be careful when you refer to ranges.

I changed this line:
If Application.CountA(Range("K5:S5")) < Range("T5") Then
to
If Application.CountA(.Range("K5:S5")) < .Range("T5").value Then

The dots mean that those ranges belong to the object in the previous with
statement. In this case, the inputwks sheet.

(I also like to use the property explicitly (.value)--instead of relying on the
default property. I think it makes the code easier to read.)


wrote:

Please help.

I need the macro to execute more than once if J5 does not equal to 0.

Example: The sequence

When I hit the button,

J5 = 5, then the procedure will execute if the value in J5 does not equal to
0 once I hit the update button.
J5 = 4, then the procedure will continue to execute.
J5 = 3, then the procedure will continue to execute.
J5 = 2, then the procedure will continue to execute.
J5 = 1, then the procedure will continue to execute.
J5 = 0, then exit sub.

Thank you.

The VBA:

Option Explicit

Sub UpdateDataWorksheet()

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 = "K5,L5,M5,N5,O5,P5,Q5,R5,S5"

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

With historyWks
nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
End With

With inputWks
Set myRng = .Range(myCopy)

If Application.CountA(Range("K5:S5")) < Range("T5") Then

Exit Sub
End If
End With


**** I think the procedure should come here *****

With historyWks
With .Cells(nextRow, "A")

oCol = 1

For Each myCell In myRng.Cells
historyWks.Cells(nextRow, oCol).Value = myCell.Value
oCol = oCol + 1
Next myCell
End With

End With

End Sub


--

Dave Peterson