Vba not responding with nested loop (priority sheet)

[nu_miniy]

Hi all, I need help with vba, I want to make vba to:

1. Search day and month from 4 sheet: Sheet1, Sheet2, Sheet3, Sheet4 from 1 January to 31 December
2. There's priority sheet sequence sheet1 ->sheet2 -> sheet3 -> sheet4, it can't be mix or the calculation will all wrong
3. So if it at 1 January the sheet1 will calculate some formula, and then I can calculate sheet2, then sheet3 and then sheet4
4. If it finish in sheet4, move the search to 2 January, and so on..

Everytime I run it, my excel and vba always not responding, but If I try only with sheet1 it works fine..
This what I make:

Sub LookingFor()
Dim i As Integer, j As Integer
Dim rcell1 As Range, rcell2 As Range, rcell3 As Range, rcell4 As Range
Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range


Set rng1 = Sheets("Sheet1").Range("C3:C700")
Set rng2 = Sheets("Sheet2").Range("C3:C700")
Set rng3 = Sheets("Sheet3").Range("C3:C700")
Set rng4 = Sheets("Sheet4").Range("C3:C700")


For i = 1 To 12 'For month'
    For j = 1 To 31 'For day'
        For Each rcell1 In rng1
            If Day(rcell1.Value) = i And Month(rcell1.Value) = j Then
                'Do something'    
            End If
'---------------------------------------------------------------------------------------------------------------------------------------'            
[INDENT]        For Each rcell2 In rng2[/INDENT]
[INDENT]            If Day(rcell2.Value) = i And Month(rcell2.Value) = j Then[/INDENT]
[INDENT]                'Do Something'[/INDENT]
[INDENT]            End If[/INDENT]
'---------------------------------------------------------------------------------------------------------------------------------------'        
[INDENT=2]        For Each rcell3 In rng3[/INDENT]
[INDENT=2]            If Day(rcell3.Value) = i And Month(rcell3.Value) = j Then[/INDENT]
[INDENT=2]                'Do Something'[/INDENT]
[INDENT=2]            End If[/INDENT]
'---------------------------------------------------------------------------------------------------------------------------------------'        
[INDENT=3]        For Each rcell4 In rng4[/INDENT]
[INDENT=3]            If Day(rcell4.Value) = i And Month(rcell4.Value) = j Then[/INDENT]
[INDENT=3]                'Do something'[/INDENT]
[INDENT=3]            End If[/INDENT]
                                Next
                        Next
                Next
        Next
    Next
Next


End Sub

 

[nu_miniy]

Hi, I already trying with modify your code with just one sheet for trial, but it get endlessly loop and I don't have any idea where the continuous loop from..

 

[ukmikeb]

Hi

Sorry, I didn't put in a check for zero rows, which you will need to change the following :-

 NoofFiltrdRows = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
 
 ' Your Processing for Sheet1 goes here
 
 rng.AutoFilter
Next I

to

 NoofFiltrdRows = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
If NoofFiltrdRows < 1 Then Goto Resetfiltr

 ' Your Processing for Sheet1 goes here
 
Resetfiltr:
 rng.AutoFilter
Next I

If you still have a problem, please list your code.

Ps You will need to refer to the data in the filtered rows using ".SpecialCells(xlCellTypeVisible)"

hth

 

[nu_miniy]

Hi,
I retry your code but it stuck in continuous loop, when I break the run seem this part where it stuck

NoofFiltrdRows = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1

And what do you mean with

Ps You will need to refer to the data in the filtered rows using ".SpecialCells(xlCellTypeVisible)"

Do I need to data range in special cell into variable?

And here my trial code:

Sub Coba()
Dim dtestart As Date, dteend As Date
Dim I As Date
Dim NoofFiltrdRows As Long
Dim rng As Range, cell As Range
Dim rng1 As Range, cell1 As Range
Dim Thisday As String
 
dtestart = DateSerial(2015, 1, 1)
dteend = DateSerial(2015, 12, 31)
'-----------------------------------------------------------------------------------------------------"
For I = dtestart To dteend Step 1
Thisday = Format(I, "dd/mm/yyyy")
 Sheets("Beli").Select
Set rng = ActiveSheet.Range("C2:C5")
rng.AutoFilter Field:=1, Criteria1:=I, Visibledropdown:=False
NoofFiltrdRows = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
If NoofFiltrdRows < 1 Then GoTo Resetfiltr


bbaris = rng.Row
bkodebrg = Cells(bbaris, "E").Value
bpcs = Cells(bbaris, "G").Value
byds = Cells(bbaris, "H").Value
bharga = Cells(bbaris, "I").Value
              
Workbooks("Peride2011 - Trial.xlsm").Sheets("Stok Barang").Activate
Columns("A:A").Select
Set cell = Selection.Find(What:=bkodebrg, After:=Range("A4"), LookAt:=xlWhole)
If cell Is Nothing Then
    MsgBox "Cell is empty"
Else
    sb_stok = Cells.Address(rowabsolute = True, columnabsolute = True)
    bdr_stok = cell.Row
    sb_pcs = Cells(bdr_stok, "G").Value
    sb_yds = CSng(Cells(bdr_stok, "H").Value)
    sb_harga = CSng(Cells(bdr_stok, "F").Value)
    b_sb_pcs = sb_pcs + bpcs
    b_sb_yds = CSng(sb_yds + byds)
    b_sb_harga = CSng(sb_harga + bharga)
    b_pokok_akhir = CSng(b_sb_harga / b_sb_yds)
    Cells(bdr_stok, 7).Value = b_sb_pcs
    Cells(bdr_stok, 8).Value = b_sb_yds
    Cells(bdr_stok, 6).Value = b_sb_harga
    Cells(bdr_stok, 5).Value = b_pokok_akhir
    Workbooks("Peride2011 - Trial.xlsm").Sheets("Beli").Activate
    Cells(bbaris, "J").Value = "TRUE"
End If
                
Resetfiltr:
rng.AutoFilter
Next I


End Sub

 

[ukmikeb]

Hi

Having filtered the dates you need to reference the filtered cells like (untested) :

For each Filtrdcell in Autofilter.Range.Offset(1).Resize(NoofFiltrdRows).SpecialCells(xlTypeVisible)
    bbaris = Filtrdcell.Row
    bkodebrg = Filtrdcell.Offset(,2).Value   'Column "E"
    bpcs = Filtrdcell.Offset(,4).Value  'Column "G"
    byds = Filtrdcell.Offset(,5).Value  'Column "H"
    bharga = Filtrdcell.Offset(,6).Value  'Column "I"
              
   Workbooks("Peride2011 - Trial.xlsm").Sheets("Stok Barang").Activate
   Columns("A:A").Select
   Set cell = Selection.Find(What:=bkodebrg, After:=Range("A4"), LookAt:=xlWhole)
   If cell Is Nothing Then
      MsgBox "Cell is empty"
   Else
      sb_stok = Cells.Address(rowabsolute = True, columnabsolute = True)
      bdr_stok = cell.Row
      sb_pcs = Cells(bdr_stok, "G").Value
      sb_yds = CSng(Cells(bdr_stok, "H").Value)
      sb_harga = CSng(Cells(bdr_stok, "F").Value)
      b_sb_pcs = sb_pcs + bpcs
      b_sb_yds = CSng(sb_yds + byds)
      b_sb_harga = CSng(sb_harga + bharga)
      b_pokok_akhir = CSng(b_sb_harga / b_sb_yds)
      Cells(bdr_stok, 7).Value = b_sb_pcs
      Cells(bdr_stok, 8).Value = b_sb_yds
      Cells(bdr_stok, 6).Value = b_sb_harga
      Cells(bdr_stok, 5).Value = b_pokok_akhir
      Workbooks("Peride2011 - Trial.xlsm").Sheets("Beli").Activate
     Filtrdcell.Offset(,7).Value = "TRUE"  'Column "J"
End If
Next Filtrdcell

hth