The code I suggested decremented the value in J1. I don't see anything in your
code that saves the workbook.

You'll have to add that save routine and this portion:

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

would become:

With HowManyTimesCell
If Int(.Value) < 1 Then
Exit Do
End If
End With


Stan wrote:

Dear Dave,

The code didn't work.

Thanks for helping me on this again. I would say it is a continuation (in a
way) of my earlier thread but this time is different. I am thinking of
looping the vba.

What I am trying to achieve:

Once I hit the execute button, IF cell J5 does not equal to zero, loop the
vba code (repeating until cell J5 becomes 0).

Inside Cell J5 : =COUNT($L$7:$L$15). *it is like a countdown meter.
Everytime an entry gets saved into the Database, J5 reduces by 1.

By doing this, I can use it to save multiple entries with 1 click of the
button and still use the same codes.

Thanks.

The VBA is

"Dave Peterson" wrote:

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


--

Dave Peterson