Excel Macro

This macro will format, sort, and count values within ranges on worksheets pval and rpb.

Sub frequencies()
' Created by Josh Loeffert

Application.ScreenUpdating = False

Sheets("pval").Select
'sort pval sheet
Columns("A:C").Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("B1"), Order1:=xlDescending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
With Selection.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Columns("A:C").Select
With Selection
.HorizontalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("B:B").Select
Selection.NumberFormat = "0.00"

'count values
Dim cellvalue
Dim firstcellcoords
Dim nextcellcoords
Dim count

count = 1
cellvalue = Range("B" & count)

If cellvalue > 0.995 Or cellvalue = Empty Then
'save first cell coords
firstcell = count

While cellvalue > 0.995 And cellvalue <> Empty
count = count + 1
nextcellcoords = "B" & count
cellvalue = Range(nextcellcoords)
Wend

'tell me how many
If count - firstcell <> 0 Then
Range("D" & count - 1).Select
ActiveCell.FormulaR1C1 = count - firstcell
Range("H6").Select
ActiveCell.FormulaR1C1 = count - firstcell
Else
Range("H6").Select
ActiveCell.FormulaR1C1 = "0"
End If
End If

If cellvalue >= 0.895 Or cellvalue = Empty Then
'save first cell coords
firstcell = count

While cellvalue >= 0.895 And cellvalue <> Empty
count = count + 1
nextcellcoords = "B" & count
cellvalue = Range(nextcellcoords)
Wend

'tell me how many .90's
If count - firstcell <> 0 Then
Range("D" & count - 1).Select
ActiveCell.FormulaR1C1 = count - firstcell
Range("H7").Select
ActiveCell.FormulaR1C1 = count - firstcell
Else
Range("H7").Select
ActiveCell.FormulaR1C1 = "0"
End If
End If

If cellvalue >= 0.795 Or cellvalue = Empty Then
'save first cell coords
firstcell = count

While cellvalue >= 0.795 And cellvalue <> Empty
count = count + 1
nextcellcoords = "B" & count
cellvalue = Range(nextcellcoords)
Wend

'tell me how many
If count - firstcell <> 0 Then
Range("D" & count - 1).Select
ActiveCell.FormulaR1C1 = count - firstcell
Range("H8").Select
ActiveCell.FormulaR1C1 = count - firstcell
Else
Range("H8").Select
ActiveCell.FormulaR1C1 = "0"
End If
End If

If cellvalue >= 0.695 Or cellvalue = Empty Then
'save first cell coords
firstcell = count

While cellvalue >= 0.695 And cellvalue <> Empty
count = count + 1
nextcellcoords = "B" & count
cellvalue = Range(nextcellcoords)
Wend

'tell me how many
If count - firstcell <> 0 Then
Range("D" & count - 1).Select
ActiveCell.FormulaR1C1 = count - firstcell
Range("H9").Select
ActiveCell.FormulaR1C1 = count - firstcell
Else
Range("H9").Select
ActiveCell.FormulaR1C1 = "0"
End If
End If

If cellvalue >= 0.595 Or cellvalue = Empty Then
'save first cell coords
firstcell = count

While cellvalue >= 0.595 And cellvalue <> Empty
count = count + 1
nextcellcoords = "B" & count
cellvalue = Range(nextcellcoords)
Wend

'tell me how many
If count - firstcell <> 0 Then
Range("D" & count - 1).Select
ActiveCell.FormulaR1C1 = count - firstcell
Range("H10").Select
ActiveCell.FormulaR1C1 = count - firstcell
Else
Range("H10").Select
ActiveCell.FormulaR1C1 = "0"
End If
End If

If cellvalue >= 0.495 Or cellvalue = Empty Then
'save first cell coords
firstcell = count

While cellvalue >= 0.495 And cellvalue <> Empty
count = count + 1
nextcellcoords = "B" & count
cellvalue = Range(nextcellcoords)
Wend

'tell me how many
If count - firstcell <> 0 Then
Range("D" & count - 1).Select
ActiveCell.FormulaR1C1 = count - firstcell
Range("H11").Select
ActiveCell.FormulaR1C1 = count - firstcell
Else
Range("H11").Select
ActiveCell.FormulaR1C1 = "0"
End If
End If

If cellvalue >= 0.395 Or cellvalue = Empty Then
'save first cell coords
firstcell = count

While cellvalue >= 0.395 And cellvalue <> Empty
count = count + 1
nextcellcoords = "B" & count
cellvalue = Range(nextcellcoords)
Wend

'tell me how many
If count - firstcell <> 0 Then
Range("D" & count - 1).Select
ActiveCell.FormulaR1C1 = count - firstcell
Range("H12").Select
ActiveCell.FormulaR1C1 = count - firstcell
Else
Range("H12").Select
ActiveCell.FormulaR1C1 = "0"
End If
End If

If cellvalue >= 0.295 Or cellvalue = Empty Then
'save first cell coords
firstcell = count

While cellvalue >= 0.295 And cellvalue <> Empty
count = count + 1
nextcellcoords = "B" & count
cellvalue = Range(nextcellcoords)
Wend

'tell me how many
If count - firstcell <> 0 Then
Range("D" & count - 1).Select
ActiveCell.FormulaR1C1 = count - firstcell
Range("H13").Select
ActiveCell.FormulaR1C1 = count - firstcell
Else
Range("H13").Select
ActiveCell.FormulaR1C1 = "0"
End If
End If

If cellvalue >= 0.195 Or cellvalue = Empty Then
'save first cell coords
firstcell = count

While cellvalue >= 0.195 And cellvalue <> Empty
count = count + 1
nextcellcoords = "B" & count
cellvalue = Range(nextcellcoords)
Wend

'tell me how many
If count - firstcell <> 0 Then
Range("D" & count - 1).Select
ActiveCell.FormulaR1C1 = count - firstcell
Range("H14").Select
ActiveCell.FormulaR1C1 = count - firstcell
Else
Range("H14").Select
ActiveCell.FormulaR1C1 = "0"
End If
End If

If cellvalue >= 0.095 Or cellvalue = Empty Then
'save first cell coords
firstcell = count

While cellvalue >= 0.095 And cellvalue <> Empty
count = count + 1
nextcellcoords = "B" & count
cellvalue = Range(nextcellcoords)
Wend

'tell me how many
If count - firstcell <> 0 Then
Range("D" & count - 1).Select
ActiveCell.FormulaR1C1 = count - firstcell
Range("H15").Select
ActiveCell.FormulaR1C1 = count - firstcell
Else
Range("H15").Select
ActiveCell.FormulaR1C1 = "0"
End If
End If

If cellvalue >= -0.0049 Or cellvalue = Empty Then
'save first cell coords
firstcell = count

While cellvalue >= -0.0049 And cellvalue <> Empty
count = count + 1
nextcellcoords = "B" & count
cellvalue = Range(nextcellcoords)
Wend

'tell me how many
If count - firstcell <> 0 Then
Range("D" & count - 1).Select
ActiveCell.FormulaR1C1 = count - firstcell
Range("H16").Select
ActiveCell.FormulaR1C1 = count - firstcell
Else
Range("H16").Select
ActiveCell.FormulaR1C1 = "0"
End If
End If

If cellvalue < -0.0049 Or cellvalue = Empty Then
'save first cell coords
firstcell = count

While cellvalue < -0.0049 And cellvalue <> Empty
Dim ans
ans = MsgBox("Error. Found negative p value. Please check data and try again.", vbOKOnly + vbExclamation, "Error!")
cellvalue = 1
Wend

'tell me how many
If count - firstcell <> 0 Then
Range("D" & count - 1).Select
ActiveCell.FormulaR1C1 = count - firstcell
Range("H17").Select
ActiveCell.FormulaR1C1 = count - firstcell
Else
Range("H17").Select
ActiveCell.FormulaR1C1 = "0"
End If
End If

Range("H19").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(R[-18]C[-6]:R[381]C[-6])"

Columns("D:D").Select
Selection.Font.Bold = True

Sheets("rpb").Select
'sort rpb sheet
Columns("A:C").Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("B1"), Order1:=xlDescending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
With Selection.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Columns("A:C").Select
With Selection
.HorizontalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("B:B").Select
Selection.NumberFormat = "0.00"

'count values
'reset variables
cellvalue = 0
firstcellcoords = 0
nextcellcoords = 0
count = 0