For/Next Loop not working

kbates79

New Member
Joined
Jun 24, 2011
Messages
11
I'm pretty new to VBA, but just when I thought I was getting the hang of it, this nested For/Next loop will not work the way I want it to.

Here is the code:
Dim I As Integer
Dim Count As Integer

For Count = 0 To 7
For I = 1 To 8
Range("B2").Select
ActiveCell.Offset(Count, 0).Value = WorksheetFunction. _
CountIf(Workbooks("EMEA.xlsx").Sheets(I).Columns(14), "REW")
Next I
Next Count

Basically I want it to loop through all the worksheets in a certain workbook, and then give me a total number for cells matching the "CountIf" criteria. The total shows up in a different workbook all together. Perhaps there is a VBA way of handling the count instead of using a worksheet function?

Thanks in advance for any help!

KB
 
Hello Jerry find below the codes.

Basically the cations and everything is the same except the combo boxes and option buttons, and they are filling the same line.

I look forward to your indispensable support on these
Thanks in advance

Private Sub CmdOK_Click()
Dim LijnFIND As Range

Application.ScreenUpdating = False
On Error Resume Next
'
With Sheets("Daily report Fab 1&2")
If txtReferentie.Text = "" Then
MsgBox ("Please enter a reference or insert XXX if there is none and add comment")
Exit Sub
End If
For i = 3 To 54
If .Cells(i, 2).Text = cboLijn And .Cells(i, 3) = Empty Then
Set LijnFIND = .Cells(i, 2)
i = 54
End If
Next i
''
'

'
'
'
If Not LijnFIND Is Nothing Then

LijnFIND.Offset(, 1).Value = txtReferentie.Value
LijnFIND.Offset(, 2).Value = cboChocolateType.Value
LijnFIND.Offset(, 3).Value = cboUnscheduledHours.Value
LijnFIND.Offset(, 8).Value = cboNoofMixesPlanned.Value
LijnFIND.Offset(, 10).Value = cboNoofMixesProduced.Value

'First downtime combobox
'Availability
If cboDTR1.Value = "A10 (Insufficient Processing Knowledge)" Then
LijnFIND.Offset(0, 27) = txtDTR1.Value
ElseIf cboDTR1.Value = "A20 (Misunderstanding / unclear arrangements)" Then
LijnFIND.Offset(0, 28) = txtDTR1.Value
ElseIf cboDTR1.Value = "A30 (Labour Interruption)" Then
LijnFIND.Offset(0, 29) = txtDTR1.Value

End If
'Rate or Availability

If optLS1S = True Then
If cboDTR1.Value = "P31 (Late conche emptying 1)" Then
LijnFIND.Offset(0, 38) = txtDTR1.Value
ElseIf cboDTR1.Value = "BT00 (Other mixing issues - please specify)" Then
LijnFIND.Offset(0, 43) = txtDTR1.Value
ElseIf cboDTR1.Value = "CT00 (Other refining tech. issues - please specify)" Then
LijnFIND.Offset(0, 46) = txtDTR1.Value

End If
'Rate
ElseIf optLS1R = True Then
If cboDTR1.Value = "P31 (Late conche emptying 1)" Then
LijnFIND.Offset(0, 76) = txtDTR1.Value
ElseIf cboDTR1.Value = "BT00 (Other mixing issues - please specify)" Then
LijnFIND.Offset(0, 78) = txtDTR1.Value
ElseIf cboDTR1.Value = "CT00 (Other refining tech. issues - please specify)" Then
LijnFIND.Offset(0, 79) = txtDTR1.Value

End If
End If

'Second downtime combobox
'Availability
If cboDTR2.Value = "A10 (Insufficient Processing Knowledge)" Then
LijnFIND.Offset(0, 27) = txtDTR2.Value
ElseIf cboDTR2.Value = "A20 (Misunderstanding / unclear arrangements)" Then
LijnFIND.Offset(0, 28) = txtDTR2.Value
ElseIf cboDTR2.Value = "A30 (Labour Interruption)" Then
LijnFIND.Offset(0, 29) = txtDTR2.Value


End If
'Rate or Availability

If optLS2S = True Then
If cboDTR2.Value = "P31 (Late conche emptying 1)" Then
LijnFIND.Offset(0, 38) = txtDTR2.Value
ElseIf cboDTR2.Value = "BT00 (Other mixing issues - please specify)" Then
LijnFIND.Offset(0, 43) = txtDTR2.Value

End If
'Rate
ElseIf optLS2R = True Then
If cboDTR2.Value = "P31 (Late conche emptying 1)" Then
LijnFIND.Offset(0, 76) = txtDTR2.Value
ElseIf cboDTR2.Value = "BT00 (Other mixing issues - please specify)" Then
LijnFIND.Offset(0, 78) = txtDTR2.Value

End If
End If

'Third downtime combobox
'Availability

'Fourth downtime combobox


'Fifth downtime combobox

'Sixth downtime combobox

LijnFIND.Offset(0, 95) = txtComments.Value

MsgBox "Transferred"

Else
MsgBox cboLijn.Value & " was not found. Please check your data."
.Activate
.Range("B3").Select
End If
End With
Application.ScreenUpdating = True
Unload Me
End Sub
 
Upvote 0

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
OK, then I'm pretty sure this syntax is sound, you'll have to execute it slowly to test. I have to think that you don't want this code to really run through all 6 comboboxes since the end results is the last combobox 6 will always end up putting its values into the same cells. Shouldn't there be some "test" as you execute each time to determine if we should a) put the values in this time through or b) abort for good?

Code:
Private Sub CmdOK_Click()
Dim LijnFIND As Range, LijnFIRST As Range
Dim MyDTR As Control, MyTXT As Control

On Error Resume Next
'
With Sheets("Daily report Fab 1&2")
    If txtReferentie.Text = "" Then
        MsgBox ("Please enter a reference or insert XXX if there is none and add comment")
        Exit Sub
    End If

    Set LijnFIND = .Range("B3:B54").Find(cboLijn, LookIn:=xlValues, LookAt:=xlWhole)
    If Not LijnFIND Is Nothing Then
        Set LijnFIRST = LijnFIND
        Do
            If IsEmpty(LijnFIND.Offset(, 1)) Then Exit Do
            Set LijnFIND = .Range("B3:B54").FindNext(LijnFIND)
        Loop Until LijnFIRST.Address = LijnFIND.Address
        
        If Not IsEmpty(LijnFIND.Offset(, 1)) Then
            MsgBox "Could not find empty line for this data"
            Exit Sub
        End If

        Application.ScreenUpdating = False

        LijnFIND.Offset(, 1).Value = txtReferentie.Value
        LijnFIND.Offset(, 2).Value = cboChocolateType.Value
        LijnFIND.Offset(, 3).Value = cboUnscheduledHours.Value
        LijnFIND.Offset(, 8).Value = cboNoofMixesPlanned.Value
        LijnFIND.Offset(, 10).Value = cboNoofMixesProduced.Value
        LijnFIND.Offset(0, 95) = txtComments.Value
        
        For Each MyDTR In Me.Controls
            If MyDTR.Name Like "cboDTR" Then
                MyTXT = Me.Controls("txtDTR" & Right(MyDTR, 1))
                Select Case Left(MyDTR.Value, 3)
                    Case "A10":     LijnFIND.Offset(0, 27) = MyTXT.Value
                    Case "A20":     LijnFIND.Offset(0, 28) = MyTXT.Value
                    Case "A30":     LijnFIND.Offset(0, 29) = MyTXT.Value
                    Case "P31"
                        If optLS1S Then
                            LijnFIND.Offset(0, 38) = MyTXT.Value
                        ElseIf optLS1R Then
                            LijnFIND.Offset(0, 76) = MyTXT.Value
                        End If
                    Case "BT0"
                        If optLS1S Then
                            LijnFIND.Offset(0, 43) = MyTXT.Value
                        ElseIf optLS1R Then
                            LijnFIND.Offset(0, 78) = MyTXT.Value
                        End If
                    Case "CT0"
                        If optLS1S Then
                            LijnFIND.Offset(0, 46) = MyTXT.Value
                        ElseIf optLS1R Then
                            LijnFIND.Offset(0, 79) = MyTXT.Value
                        End If
                End Select
            End If
        Next MyDTR
        MsgBox "Transferred"
        
    Else
        MsgBox cboLijn.Value & " was not found. Please check your data."
        .Activate
        .Range("B3").Select
    End If
End With

Application.ScreenUpdating = True
Unload Me
End Sub
 
Upvote 0

Forum statistics

Threads
1,224,612
Messages
6,179,890
Members
452,948
Latest member
Dupuhini

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top