Creating Bins Via VBA/Macros

[Donae]

I have to create a program using VBA. This program needs to create 10 bins from the number 0 to 1 after it creates the bin I need it to count the occurrence (or frequencies) of the bin. including numbers in that range that occur more than once. From the occurrences of the bin number, I need to overall averages of these bins. I know it is a program in excel that calculates this for you, however, I NEED CODE. Thank you. Here a few facts: Of course the data is on spreadsheets in Excel. The two worksheets that I am using data from are labeled D3 and D4, both require the same outcome. It would be great if I could get a blank cell between the bins, although it's not required. The data from the spreadsheets are only in columns A and B (the ending row varies dependant on the data). Lastly,the example of one bin would be 0.101 to 0.2, 0.201 to 0.3...ect to include all numbers between 0 and 1. And the ultimate goal is to create a graph that reflects the bins on one axis and the percentage of occurrences on the other axis. Here is the code I created. It creates the bins BUT does not use all the data.Nor does it calculate the occurrences. Please Help!! Thanks

Option Explicit
Sub myMacro()
Dim nRow As Integer
Dim d3 As Worksheet
Dim d4 As Worksheet
Dim endRowColumn1 As Integer
Dim endRowColumn2 As Integer

Set d3 = ActiveWorkbook.Sheets(1)
Set d4 = ActiveWorkbook.Sheets(1)
endRowColumn1 = d3.Cells(Rows.Count, 1).End(xlUp).Row
endRowColumn2 = d3.Cells(Rows.Count, 2).End(xlUp).Row
   endRowColumn1 = d4.Cells(Rows.Count, 1).End(xlUp).Row
endRowColumn2 = d4.Cells(Rows.Count, 2).End(xlUp).Row
' Clear results from last run
d3.Range("C:E").Clear ' Clear rows 3,4,5,6,7,8,9,10,11,12
d3.Cells(1, 3) = "Bin1"
d3.Cells(1, 4) = "Bin2"
d3.Cells(1, 5) = "Bin3"
d3.Cells(1, 6) = "Bin4"
d3.Cells(1, 7) = "Bin5"
d3.Cells(1, 8) = "Bin6"
d3.Cells(1, 9) = "Bin7"
d3.Cells(1, 10) = "Bin8"
d3.Cells(1, 11) = "Bin9"
d3.Cells(1, 12) = "Bin10"
d4.Range("C:E").Clear ' Clear rows 3,4,5,6,7,8,9,10,11,12
d4.Cells(1, 3) = "Bin1"
d4.Cells(1, 4) = "Bin2"
d4.Cells(1, 5) = "Bin3"
d4.Cells(1, 6) = "Bin4"
d4.Cells(1, 7) = "Bin5"
d4.Cells(1, 8) = "Bin6"
d4.Cells(1, 9) = "Bin7"
d4.Cells(1, 10) = "Bin8"
d4.Cells(1, 11) = "Bin9"
d4.Cells(1, 12) = "Bin10"

' STARTING WITH SECOND ROW
For nRow = 2 To endRowColumn1 ' For each row... to the end of your rows..
' If the first bin criteria is met...
If (d3.Cells(nRow, 1) >= 0.001) And _
(d3.Cells(nRow, 1) < 0.12) Then
' Then put the value into the first bin. (column C)
d3.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0) = d3.Cells(nRow, 1)
ElseIf (d3.Cells(nRow, 1) >= 0.12) And _
(d3.Cells(nRow, 1) < 0.2) Then
' Then put the value into the second bin. (column D)
d3.Cells(Rows.Count, 4).End(xlUp).Offset(1, 0) = d3.Cells(nRow, 1)
Else ' No Criteria Met
d3.Cells(Rows.Count, 5).End(xlUp).Offset(1, 0) = d3.Cells(nRow, 1)
End If
Next nRow
For nRow = 2 To endRowColumn2 ' For each row... to the end of your rows..
' If the first bin criteria is met...
If (d3.Cells(nRow, 2) >= 0.001) And _
(d3.Cells(nRow, 2) < 0.12) Then
' Then put the value into the bin. (column C)
d3.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0) = d3.Cells(nRow, 2)
ElseIf (d3.Cells(nRow, 2) >= 0.12) And _
(d3.Cells(nRow, 2) < 0.2) Then
' Then put the value into the second bin. (column D)
d3.Cells(Rows.Count, 4).End(xlUp).Offset(1, 0) = d3.Cells(nRow, 2)
Else ' No Criteria Met
d3.Cells(Rows.Count, 5).End(xlUp).Offset(1, 0) = d3.Cells(nRow, 2)
End If
Next nRow
' STARTING WITH SECOND ROW
For nRow = 2 To endRowColumn1 ' For each row... to the end of your rows..
' If the first bin criteria is met...
If (d4.Cells(nRow, 1) >= 0.001) And _
(d4.Cells(nRow, 1) < 0.12) Then
' Then put the value into the first bin. (column C)
d4.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0) = d4.Cells(nRow, 1)
ElseIf (d4.Cells(nRow, 1) >= 0.12) And _
(d4.Cells(nRow, 1) < 0.2) Then
' Then put the value into the second bin. (column D)
d4.Cells(Rows.Count, 4).End(xlUp).Offset(1, 0) = d4.Cells(nRow, 1)
Else ' No Criteria Met
d4.Cells(Rows.Count, 5).End(xlUp).Offset(1, 0) = d4.Cells(nRow, 1)
End If
Next nRow
For nRow = 2 To endRowColumn2 ' For each row... to the end of your rows..
' If the first bin criteria is met...
If (d4.Cells(nRow, 2) >= 0.001) And _
(d4.Cells(nRow, 2) < 0.12) Then
' Then put the value into the bin. (column C)
d4.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0) = d4.Cells(nRow, 2)
ElseIf (d4.Cells(nRow, 2) >= 0.12) And _
(d4.Cells(nRow, 2) < 0.2) Then
' Then put the value into the second bin. (column D)
d4.Cells(Rows.Count, 4).End(xlUp).Offset(1, 0) = d4.Cells(nRow, 2)
Else ' No Criteria Met
d4.Cells(Rows.Count, 5).End(xlUp).Offset(1, 0) = d4.Cells(nRow, 2)
End If
Next nRow
End Sub

 

[Takae]

Same worksheet? This code uses only one worksheet.
Set d3 = ActiveWorkbook.Sheets(1)
Set d4 = ActiveWorkbook.Sheets(1)

Hope this helps.

Sub myMacro()
Dim nRow As Integer
Dim d3 As Worksheet
Dim d4 As Worksheet
Dim LR3A As Integer, LR3B As Long, LR4A As Integer, LR4B As Long, i As Long
Dim w

Set d3 = Sheets("d3")
Set d4 = Sheets("d4")
LR3A = d3.Cells(Rows.Count, 1).End(xlUp).Row
LR3B = d3.Cells(Rows.Count, 2).End(xlUp).Row
LR4A = d4.Cells(Rows.Count, 1).End(xlUp).Row
LR4B = d4.Cells(Rows.Count, 2).End(xlUp).Row
' Clear results from last run

For Each w In Sheets(Array("d3", "d4"))
    With w
        .Range("C:E").Clear
        For i = 3 To 12
            .Cells(1, i).Value = "Bin" & i - 2
        Next

    ' STARTING WITH SECOND ROW
    For i = 2 To LR3A ' For each row... to the end of your rows..
        ' If the first bin criteria is met...
        If .Cells(i, 1).alue >= 0.001 And .Cells(i, 1).Value < 0.2 Then
            If .Cells(i, 1).Value < 0.12 Then
                .Cells(Rows.Count, 3).End(xlUp).Offset(1, 0) = .Cells(i, 1).Value
            Else
                .Cells(Rows.Count, 4).End(xlUp).Offset(1, 0) = .Cells(i, 1).Value
        Else
            .Cells(Rows.Count, 5).End(xlUp).Offset(1, 0) = .Cells(i, 1).Value
        End If
        Next
 End With
Next
End Sub

 

[Donae]

Thank you. I am getting a compiler error at the last Else statement. It states "Else without If". Any suggestions?

 

[Takae]

Sorry, I rewrote as below.
Please try it again.

Sub myMacro()Dim nRow As Integer, i As Long
Dim d3 As Worksheet
Dim d4 As Worksheet
Dim w


Set d3 = Sheets("d3")
Set d4 = Sheets("d4")


    For Each w In Sheets(Array("d3", "d4"))
        With w
            .Range("C:E").Clear
            For i = 3 To 12
                .Cells(1, i).Value = "Bin" & i - 2
            Next
    
            For i = 1 To 2
                For nRow = 2 To .Cells(Rows.count, i).End(xlUp).row
                    If .Cells(nRow, i).Value >= 0.001 And .Cells(nRow, i) < 0.2 Then
                        If .Cells(nRow, i).Value >= 0.12 Then
                            .Cells(Rows.count, 4).End(xlUp).Offset(1, 0) = .Cells(nRow, i).Value
                        Else
                            .Cells(Rows.count, 3).End(xlUp).Offset(1, 0) = .Cells(nRow, i).Value
                        End If
                    Else
                        .Cells(Rows.count, 5).End(xlUp).Offset(1, 0) = .Cells(nRow, i).Value
                    End If
                Next
            Next
        End With
    Next
End Sub

 

[Donae]

Thank you. While the code does create the bins and place some in the correct bins but not all. I guess I will see if I can manipulate the numbers.