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

Trying to loop vba

MikeWB

New Member
Hi All

As a novice, I am trying to loop through an if statement which I have working, but I now want to add a second loop to repeat x number of times.

I have a form which asks "repeat" and then a further question, how often.

For example today id 19/04/14, I want to repeat 2, frequency 7.

So, I want VBA to run through my loop x2, 1st time with a date of 19/04/14 and then 2nd time with a date of 26/04/14.

I have attached my working file (not too pretty), but on the data entry tab I have a button to run the code. As you will see, I have tried to loop the loop, so to speak, but I haven't been able to achieve it.

Can anyone help a frustrated novice??!
 

Attachments

  • tt0.011.xlsm
    312.8 KB · Views: 9
Hi Mike,

Welcome to the forum..
Unfortunately.. I dont have enough time to go through all the userform..
Just trying to give an idea.. how to proceed.. check this one,

Code:
Sub test()
Dim idate As Long, iRepeat As Long, iFrequency As Long
  idate = Date
  iRepeat = InputBox("No of repeat ", , 2)
  iFrequency = InputBox("Frequency ", , 7)
  k = 2
  For i = 1 To iRepeat * iFrequency Step iFrequency
  Cells(k, 1) = idate + i
  k = k + 1
  Next i
End Sub
 
Don't use gotos.

Put everything in a loop. This is just on the fly and it won't work, but you'll get the idea:

sub populsatesomestuff()
dim sometext1 as string
dim sometext2 as string
dim sometext3 as string
dim somedate as date
dim repeatvalue as integer
dim dateholder as date

for i = 1 to repeatvalue
if i > 1 then
dateholder = somedate + (i-1)
end if

somesheet.somecell = sometext1
somesheet.somecell = sometext2
somesheet.somecell = sometext3
somesheet.somecell = dateholder
next i
 
Thanks Dan

I now have it working with the goto. I have tried swapping out the goto with your example above, but without using the goto, I cannot get my code to loop through the date changes.

Ive tried adding a "for i" as above, but it doesn't run through the loop correctly?

With help of the above, this is what I've managed so far. Can you help identify where I've gone wrong? The other thing is that the loop after 60+ lines is extremely slow - any ideas on that??

Thanks again..

Code:
Dim dteDate As Date
Dim strCounter As String
Dim strRepeat As Long
Dim strNoofSession As String
Dim strPatient As String
Dim objCell As Object
Dim strFacilitiator  As String
Dim strSessionname As String
Dim strActualStartTime As String
Dim strActualEndTime As String
Dim strSessionTime As Date
Dim strRepeatCounter As Long
Dim idate As Date
Dim iRepeat As String
Dim iFrequency As Long
Dim I As Long


strSessionTime = cboDateOptions
iRepeat = 1
strRepeatCounter = 0
idate = cboDateOptions
iFrequency = cboRepeat

    Range("tblData[[#Headers],[DATE & TIME SLOT]]").Select
    Selection.AutoFilter
    ActiveSheet.ListObjects("tblData").Range.AutoFilter Field:=1, Criteria1:= _
    "="
   
    Range("B4").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select


If ActiveCell.Offset(1, 0).Formula <> "" Then
        Selection.End(xlDown).Select
End If
 
1
  For I = 1 To iRepeat Step iFrequency
   
    Sheets("data source").Select
    Range("A6").Select
    Selection.CurrentRegion.Select
   

    For Each objCell In Selection
   
        strPatient = objCell.Formula
        Sheets("data entry").Activate

        If strPatient <> "Patientname" Then
         
              strNoofSession = txtNoSessions.Value
              strFacilitiator = cboFacilitator.Text
              strSessionname = cboSessionname
              strActualStartTime = CboActualStarttime
              strActualEndTime = cboActualEndTime
              strSessionTime = Format(strSessionTime, "dd/mm/yyyy hh:mm")
             
              ActiveCell.Value = strSessionTime
              ActiveCell.Offset(0, 1).Formula = strPatient
              ActiveCell.Offset(0, 2).Formula = cboSessionname & " " & strFacilitiator
              ActiveCell.Offset(0, 6).Formula = strSessionname
              ActiveCell.Offset(0, 7).Formula = strActualEndTime - strActualStartTime
              ActiveCell.Offset(0, 3).Formula = strFacilitiator
              ActiveCell.Offset(0, 4).Formula = Format(strActualStartTime, "hh:mm")
              ActiveCell.Offset(0, 5).Value = Format(strActualEndTime, "hh:mm")
              ActiveCell.Offset(0, 10).Value = Now()
              ActiveCell.Offset(1, 0).Range("A1").Select
                   
              End If
             
        Next objCell
Next I 'Did remove and move further down.


    strSessionTime = idate + cboRepeat
    idate = strSessionTime
    strRepeatCounter = strRepeatCounter + 1

If strRepeatCounter < txtNoSessions Then
 
    GoTo 1
   
    ' *** this is where I put my next I instead of above but it doesn't loop??
   
   
End If
   
    Unload Me
Thanks Dan

I now have it working with the goto. I have tried swapping out the goto with your example above, but without using the goto, I cannot get my code to loop through the date changes.

Ive tried adding a "for i" as above, but it doesn't run through the loop correctly?

With help of the above, this is what I've managed so far. Can you help identify where I've gone wrong? The other thing is that the loop after 60+ lines is extremely slow - any ideas on that??

Thanks again...
 
Thanks Debraj,

Between your code and Dan's, this has been a great help - how I have other questions!
 
Hi Mike ,

See your file.

I think some more changes will be required , but I have no idea what exactly you wish to do , what times should actually appear in the Data Entry tab. If you can explain , the uploaded code can be further modified to do what you want.

Narayan
 

Attachments

  • tt0.011.xlsm
    301 KB · Views: 1
Guys - A BIG THANK YOU TO YOU ALL!!!

Within a couple of days, I have been able to move my project on leaps and bounds - and then, I get stuck again...

Now I have moved on, I have a slightly different problem. I have a filtered set of data, and what I want to do is loop through the filtered data and amend each row.

When I run my loop, it amends to the right column, but is not moving to each filtered row - it simply goes b5, b6, b7 etc, instead of going through the filtered rows, for example b5,b7,b66 etc.

Can anyone help me on this one? I think I may have been a little ambitious!!!



Code:
'B4 is my header row and the column I want to loop.
Range("B4").Select

  ActiveCell.Offset(1, 0).Select
 
  Do
          ActiveCell.Offset(0, 12).Value = Now()
          ActiveCell.Offset(1, 0).Select
    Loop Until Rows(ActiveCell.Row).Hidden = False
 
Hi, MIkeWB!
Try this code:
Code:
Option Explicit

Sub Unga()
'B4 is my header row and the column I want to loop.
    Dim r As Range
    Dim I As Long
    Set r = Range([B4].Offset(1, 0), [B4].End(xlDown).End(xlDown).End(xlUp))
    With r
        I = 1
        Do Until I > .Rows.Count
            If Not .Cells(I, 1).EntireRow.Hidden Then .Cells(I, 2).Value = Now()
            I = I + 1
        Loop
    End With
    Set r = Nothing
End Sub
Regards!
 
Back
Top