'By Jeremy Carlson - Michigan Technological University - jmcarlso@mtu.edu
'*******************************************************************************************
'*******************************************************************************************
' Visual Basic Script to Take Scanned Black and White Images of Portland Cement Concrete
' and Analyze Air Void systems per ASTM C457 Procedure A and B.  Also allows for the ability
' to perform a manual point count on an image in order to determine the paste content of the
' sample for use in the ASTM C457 calculations.
'
' This version of the script "bubble_counter_v2007.0.vbs" has been modified slightly
' by Karl Peterson - krpeters@mtu.edu
'*******************************************************************************************
'Additional notes from K. Peterson:
'
'This version of Jeremy's script is designed to determine a single optimum threshold value to be used
'for all subsequent analyses. The optimum threshold value is determined by iteratively changing the
'threshold level on a number of samples, and comparing the results to MANUALLY determined results
'previously determined for the same samples. The scanned images must be cropped down to the area
'desired to be analyzed. The script also requires an excel file with a list of
'the filenames (without .tif extension), and numbers for either the paste volume to aggregate
'volume ratio (from mix design) or the paste volume or aggregate volume (from a point count,
'or from just guessing). The batch file should be named "batch_file.xls" and placed in
'the location Path1 (below). The batch file should also contain the MANUALLY determined air content
'(vol% air) and void frequency (voids/millimeter) values. See example batch_file.xls for exact format.
'
'*******************************************************************************************
' Define locations of files and folders used in analysis.

' IPath is the location of the testing lab's logo which is displayed on the final report.
' ***Note: for the report to format properly the logo should be 360 pixels wide by 67 pixels high.***
Ipath = "C:\Program Files\AirVoids\Misc\MTU.gif"
PathA = "C:\Program Files\AirVoids\Misc\"

' Path1 is the location of the scanned images to be analyzed by the program
Path1 = "C:\Program Files\AirVoids\ScannedImages\"

' Path2 is the location where images and files are stored during the operation
Path2 = "C:\Program Files\AirVoids\AnalysisData\"

' Path3 is the location of the saved Result files created by the program
Path3 = "C:\Program Files\AirVoids\Results\"

' Helper is the location of the C457.hlp file.
' ***Note: if the help file is placed in the same folder as the *.vbs file, the next line can be left as is.***
Helper = "C457.hlp"
'*******************************************************************************************
'*******************************************************************************************
'*******************************************************************************************
'*******************************************************************************************
' Set Location of Input Boxes to be Displayed on Screen
XBox = 7000
YBox = 4000
XBox2 = 10000
YBox2 = 2000
'*******************************************************************************************
'###########################################################################################
'Set parameters for Batch Analyses

'NumIts is the "number of iterations." It controls the total traverse length, one iteration
'equals one set of 19 parallel lines. The total length depends on the size of the area analyzed.
'If doing multiple iterations, the position of the set of 19 lines is shifted between iterations.

'ThreshValue is the threshold value (a constant) you wish to use for the analyses

'You will also need to fill out an excel spreadsheet named "batch_file.xls" that contains the
'filenames (without the .tif extension) and corresponding values for either the paste/aggregate
'volume ratio (from mix design) or the paste vol% or the agg vol% (from either guessing or point
'counting.

'###########################################################################################
NumIts = 2
BatchFile = Path1 & "batch_file.xls"
BatchTemp = Path1 & "batch_temp.xls"
Set xlsApp = CreateObject("Excel.Application")
  With xlsApp
   xlsApp.Visible = False
  End With
xlsApp.Workbooks.Open BatchFile
xlsApp.Range("A1:D102").Select
  xlsApp.Selection.Copy
xlsApp.Workbooks.Add
  xlsApp.Selection.PasteSpecial 12
xlsApp.Range("F1").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=COUNTA(R[1]C[-5]:R[101]C[-5])"
BatchDone = xlsApp.Range("F1")
xlsApp.DisplayAlerts = False
  xlsApp.ActiveWorkbook.Close False
   xlsApp.ActiveWorkbook.Close True
   xlsApp.Quit
BatchNum = 0
Do Until BatchNum = BatchDone
BatchNum = BatchNum + 1
CellNum = BatchNum + 1
Cell = "A" & CellNum
CellPasteAggRatio = "B" & CellNum
CellPastePercent = "C" & CellNum
CellAggPercent = "D" & CellNum
CellManAir = "E" & CellNum
CellManFreq = "F" & CellNum
Set xlsApp = CreateObject("Excel.Application")
  With xlsApp
   xlsApp.Visible = False
   xlsApp.Workbooks.Open BatchFile
  End With
    Defaultfile = xlsApp.Range(Cell)
    ManAir = xlsApp.Range(CellManAir)
    ManVoidFreq = xlsApp.Range(CellManFreq)
    Testpa = xlsApp.Range(CellPasteAggRatio)
    Testpp = xlsApp.Range(CellPastePercent)
    Testap = xlsApp.Range(CellAggPercent)
     If Testpp > 1 Then
     Datachunk = "pp"
     Paste = Testpp
     Else
      If Testap > 1 Then
      Datachunk = "ap"
      NotAggPct = 100 - Testap
       Else
       Datachunk = "pa"
       PasteAggRatio = Testpa
      End If
     End If
   xlsApp.ActiveWindow.Close True, BatchFile
   xlsApp.Quit

ProjID = "dissertation"
SampleID = Defaultfile
TestLab = "Purdue"
Nerd1 = "Matt"
Nerd2 = "Matt"
SaveFileName = Defaultfile
file = Defaultfile
Filename = Path1 & file & ".tif"

 '*******************************************************************************************
 ' Define Photoshop Application to Be Used In Script
 Set appRef1 = CreateObject("Photoshop.Application")
 '*******************************************************************************************
 ' Sets Photoshop Ruler Units as Pixels
 strtRulerUnits = appRef1.Preferences.RulerUnits
 appRef1.Preferences.RulerUnits = 1
 '*******************************************************************************************
    ' Open Scanned Image
   Set ScanDoc = appRef1.Open(Filename)


'*******************************************************************************************
' Defines the resolution (fixed as constant in this version)

Resolution = 8
Xsel = ScanDoc.Width
Ysel = ScanDoc.Height




' Figures out the dimensions of the area selected for analysis for the dumbed-down image inlcuded in the report

If Ysel > Xsel Then
Aj = Ysel / 586
Xa = Xsel / Aj
Ya = Ysel / Aj
PicRatio = 300 / 586
ActualRatio = Xa / Ya
If ActualRatio > PicRatio Then
Ak = Xa / 300
Xa = Xa / Ak
Ya = Ya / Ak
End If
Else
Aj = Xsel / 300
Xa = Xsel / Aj
Ya = Ysel / Aj
End If

'*******************************************************************************************
' Create Excel Sized (2 pix wide) Sections of Scanned Image

NumberRotations=1
For Rot = 1 To NumberRotations
 For Trials = 1 To NumIts
 If FilterYN = 6 Then
  w = 125
 Else
  w = 2
 End If
 X = ScanDoc.Width
 i = 0
 n = Round(X / 19, 0)
  For j = 1 To 19
  ScanDoc.Selection.Select Array(Array(i * n + Trials, 0), Array(w + i * n + Trials, 0), Array(w + i * n + Trials, Ysel), Array(i * n + Trials, Ysel))
  ScanDoc.Selection.Copy

  ' Create New Image of Copied Section of Scanned Image and Paste Copied Section
  fileName2 = Rot & "_" & Trials & "_Clip" & i
  Set fileName4 = appRef1.Documents.Add(w, Ysel,72,"temp",1)
   fileName4.ActiveLayer.Invert
  fileName4.Paste
  fileName4.Flatten
  If FilterYN = 6 Then
   fileName4.ResizeCanvas 2, Ysel
   fileName3 = Path2 & fileName2 & ".tif"
   fileName4.SaveAs fileName3
   appRef1.DoAction "CliptoText", "C457.atn"
   fileName4.Close
  Else
   fileName4.ResizeCanvas 2, Ysel
   fileName3 = Path2 & fileName2 & ".tif"

 Set tifSaveOptions = CreateObject( "Photoshop.TIFFSaveOptions" )
tifSaveOptions.ImageCompression = 1
filename4.SaveAs filename3, tifSaveOptions, True, extType

   fileName4.Close ( 2)
  End If
  i = i + 1
  Next
 Next
' here's where to insert "ScanDoc.RotateCanvas 90" if the NumberRotations is set to >1.
Next
'*******************************************************************************************
' Resize and Save Image for Display on Opening Page of Final Report
Set ScanDoc = appRef1.ActiveDocument
ScanDoc.ResizeImage Xa, Ya, 150, 4
ThumbNailx = ScanDoc.Width
ThumbNailY = ScanDoc.Height
    
Set Bcolor = appRef1.BackgroundColor

    With Bcolor
        .RGB.Red = 255
        .RGB.Green = 255
        .RGB.Blue = 255
    End With

ScanDoc.ResizeCanvas 300, 586
fileNameRa = "Report.jpg"
fileNameR = Path1 & fileNameRa

Set jpgSaveOptions = CreateObject("Photoshop.JPEGSaveOptions")
jpgSaveOptions.EmbedColorProfile = True
jpgSaveOptions.FormatOptions = 1
jpgSaveOptions.Matte = 1
jpgSaveOptions.Quality = 10
ScanDoc.SaveAs fileNameR, jpgSaveOptions, True, extType
ScanDoc.Close (2)

' Create Mosaic File of 2 pix wide sections obtained in previous step

For Rot2 = 1 To NumberRotations
 For Mos = 1 To NumIts
  Set Mosaic = appRef1.Documents.Add(19, Ysel,72,"temp",1)
  l = -9
  For k = 0 To 18
   m = (-1 * l) - k
   MosaicFile = Rot2 & "_" & Mos & "_Clip" & k & ".tif"
   MfileName = Path2 & MosaicFile
   MDoc = "MDoc" & q
   Set MDoc = appRef1.Open(MfileName)
   MDoc.Selection.SelectAll
   MDoc.Selection.Copy
   MDoc.Close 2
   Mosaic.Paste
   Mosaic.ActiveLayer.Translate m, 0
   Mosaic.Flatten
  Next
  fileNameMM = Rot2 & "_" & Mos & "_ClipMosaic"
  fileNameMMM = Path2 & fileNameMM & ".tif"
Mosaic.SaveAs fileNameMMM, tifSaveOptions, True, extType
  Mosaic.Close 2
 Next
Next

'make worksheet to store results of optimum threshold search

If BatchNum = 1 Then
Set xlsApp = Createobject("Excel.Application")
  With xlsApp
   xlsApp.Visible = True
   xlsApp.Workbooks.Add
  End With
 xlsApp.Range("A1").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=NOW()"
 xlsApp.Range("A2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=DAY(R[-1]C)"
 xlsApp.Range("A3").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=MONTH(R[-2]C)"
 xlsApp.Range("A4").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=YEAR(R[-3]C)"
 xlsApp.Range("A2:A4").Select
 xlsApp.Selection.Copy   
 xlsApp.Selection.pastespecial 12
 OptOne = xlsApp.Range("A2")
 OptTwo = xlsApp.Range("A3")
 OptThree = xlsApp.Range("A4")
 xlsApp.Range("A1").select
 xlsApp.ActiveCell.FormulaR1C1 = "FileName"
 xlsApp.Range("C1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Minimum"

OptThreshFile = Path1 & "Optimized_" & OptOne & "_" & OptTwo & "_" & OptThree & ".xls"
xlsApp.Sheets.Add.Name = Defaultfile
 xlsApp.Range("A1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Threshold"
 xlsApp.Range("B1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Air Pix"
 xlsApp.Range("C1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Not Air Pix"
 xlsApp.Range("D1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Total Pix"
 xlsApp.Range("F1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Air %"
 xlsApp.Range("G1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Not Air %"
 xlsApp.Range("H1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Total %"
 xlsApp.Range("J1").select
 xlsApp.ActiveCell.FormulaR1C1 = "# Intercepts"
 xlsApp.Range("K1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Traverse Pix"
 xlsApp.Range("L1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Res/Pixel"
 xlsApp.Range("M1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Trav. (mm)"
 xlsApp.Range("N1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Voids/mm"
 xlsApp.Range("O1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Paste %"
 xlsApp.Range("P1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Paste/Air"
 xlsApp.Range("Q1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Chord L."
 xlsApp.Range("R1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Sp. Surf."
 xlsApp.Range("S1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Sp. Factor"
 xlsApp.Range("T1").select 
xlsApp.ActiveCell.FormulaR1C1 = "Absdev Air"
 xlsApp.Range("U1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Absdev Paste"
 xlsApp.Range("V1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Combined"
 xlsApp.Range("W1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Threshold"
 xlsApp.Range("X1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Minimum"
   xlsApp.ActiveWindow.Close True, OptThreshFile
   xlsApp.Quit
Else
 Set xlsApp = CreateObject("Excel.Application")
   With xlsApp
    xlsApp.Visible = False
    xlsApp.DisplayAlerts = False
    xlsApp.Workbooks.Open OptThreshFile
   End With
xlsApp.Sheets.Add.Name = Defaultfile
 xlsApp.Range("A1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Threshold"
 xlsApp.Range("B1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Air Pix"
 xlsApp.Range("C1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Not Air Pix"
 xlsApp.Range("D1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Total Pix"
 xlsApp.Range("F1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Air %"
 xlsApp.Range("G1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Not Air %"
 xlsApp.Range("H1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Total %"
 xlsApp.Range("J1").select
 xlsApp.ActiveCell.FormulaR1C1 = "# Intercepts"
 xlsApp.Range("K1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Traverse Pix"
 xlsApp.Range("L1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Res/Pixel"
 xlsApp.Range("M1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Trav. (mm)"
 xlsApp.Range("N1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Voids/mm"
 xlsApp.Range("O1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Paste %"
 xlsApp.Range("P1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Paste/Air"
 xlsApp.Range("Q1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Chord L."
 xlsApp.Range("R1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Sp. Surf."
 xlsApp.Range("S1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Sp. Factor"
 xlsApp.Range("T1").select 
xlsApp.ActiveCell.FormulaR1C1 = "Absdev Air"
 xlsApp.Range("U1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Absdev Voidfreq"
 xlsApp.Range("V1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Combined"
 xlsApp.Range("W1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Threshold"
 xlsApp.Range("X1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Minimum"
   xlsApp.ActiveWindow.Close True, OptThreshFile
   xlsApp.Quit
End If



'#########################################################################################
' apply multiple thresholds here
'#########################################################################################

ThreshNum = 0
Do Until ThreshNum = 154
ThreshNum = ThreshNum + 1

If ThreshNum = 1 Then
ThreshValue = 10
End If
If ThreshNum = 2 Then
ThreshValue = 20
End If
If ThreshNum = 3 Then
ThreshValue = 30
End If
If ThreshNum = 4 Then
ThreshValue = 35
End If
If ThreshNum = 5 Then
ThreshValue = 36
End If
If ThreshNum = 6 Then
ThreshValue = 37
End If
If ThreshNum = 7 Then
ThreshValue = 38
End If
If ThreshNum = 8 Then
ThreshValue = 39
End If
If ThreshNum = 9 Then
ThreshValue = 40
End If
If ThreshNum = 10 Then
ThreshValue = 41
End If
If ThreshNum = 11 Then
ThreshValue = 42
End If
If ThreshNum = 12 Then
ThreshValue = 43
End If
If ThreshNum = 13 Then
ThreshValue = 44
End If
If ThreshNum = 14 Then
ThreshValue = 45
End If
If ThreshNum = 15 Then
ThreshValue = 46
End If
If ThreshNum = 16 Then
ThreshValue = 47
End If
If ThreshNum = 17 Then
ThreshValue = 48
End If
If ThreshNum = 18 Then
ThreshValue = 49
End If
If ThreshNum = 19 Then
ThreshValue = 50
End If
If ThreshNum = 20 Then
ThreshValue = 51
End If
If ThreshNum = 21 Then
ThreshValue = 52
End If
If ThreshNum = 22 Then
ThreshValue = 53
End If
If ThreshNum = 23 Then
ThreshValue = 54
End If
If ThreshNum = 24 Then
ThreshValue = 55
End If
If ThreshNum = 25 Then
ThreshValue = 56
End If
If ThreshNum = 26 Then
ThreshValue = 57
End If
If ThreshNum = 27 Then
ThreshValue = 58
End If
If ThreshNum = 28 Then
ThreshValue = 59
End If
If ThreshNum = 29 Then
ThreshValue = 60
End If
If ThreshNum = 30 Then
ThreshValue = 61
End If
If ThreshNum = 31 Then
ThreshValue = 62
End If
If ThreshNum = 32 Then
ThreshValue = 63
End If
If ThreshNum = 33 Then
ThreshValue = 64
End If
If ThreshNum = 34 Then
ThreshValue = 65
End If
If ThreshNum = 35 Then
ThreshValue = 66
End If
If ThreshNum = 36 Then
ThreshValue = 67
End If
If ThreshNum = 37 Then
ThreshValue = 68
End If
If ThreshNum = 38 Then
ThreshValue = 69
End If
If ThreshNum = 39 Then
ThreshValue = 70
End If
If ThreshNum = 40 Then
ThreshValue = 71
End If
If ThreshNum = 41 Then
ThreshValue = 72
End If
If ThreshNum = 42 Then
ThreshValue = 73
End If
If ThreshNum = 43 Then
ThreshValue = 74
End If
If ThreshNum = 44 Then
ThreshValue = 75
End If
If ThreshNum = 45 Then
ThreshValue = 76
End If
If ThreshNum = 46 Then
ThreshValue = 77
End If
If ThreshNum = 47 Then
ThreshValue = 78
End If
If ThreshNum = 48 Then
ThreshValue = 79
End If
If ThreshNum = 49 Then
ThreshValue = 80
End If
If ThreshNum = 50 Then
ThreshValue = 81
End If
If ThreshNum = 51 Then
ThreshValue = 82
End If
If ThreshNum = 52 Then
ThreshValue = 83
End If
If ThreshNum = 53 Then
ThreshValue = 84
End If
If ThreshNum = 54 Then
ThreshValue = 85
End If
If ThreshNum = 55 Then
ThreshValue = 86
End If
If ThreshNum = 56 Then
ThreshValue = 87
End If
If ThreshNum = 57 Then
ThreshValue = 88
End If
If ThreshNum = 58 Then
ThreshValue = 89
End If
If ThreshNum = 59 Then
ThreshValue = 90
End If
If ThreshNum = 60 Then
ThreshValue = 91
End If
If ThreshNum = 61 Then
ThreshValue = 92
End If
If ThreshNum = 62 Then
ThreshValue = 93
End If
If ThreshNum = 63 Then
ThreshValue = 94
End If
If ThreshNum = 64 Then
ThreshValue = 95
End If
If ThreshNum = 65 Then
ThreshValue = 96
End If
If ThreshNum = 66 Then
ThreshValue = 97
End If
If ThreshNum = 67 Then
ThreshValue = 98
End If
If ThreshNum = 68 Then
ThreshValue = 99
End If
If ThreshNum = 69 Then
ThreshValue = 100
End If
If ThreshNum = 70 Then
ThreshValue = 101
End If
If ThreshNum = 71 Then
ThreshValue = 102
End If
If ThreshNum = 72 Then
ThreshValue = 103
End If
If ThreshNum = 73 Then
ThreshValue = 104
End If
If ThreshNum = 74 Then
ThreshValue = 105
End If
If ThreshNum = 75 Then
ThreshValue = 106
End If
If ThreshNum = 76 Then
ThreshValue = 107
End If
If ThreshNum = 77 Then
ThreshValue = 108
End If
If ThreshNum = 78 Then
ThreshValue = 109
End If
If ThreshNum = 79 Then
ThreshValue = 110
End If
If ThreshNum = 80 Then
ThreshValue = 111
End If
If ThreshNum = 81 Then
ThreshValue = 112
End If
If ThreshNum = 82 Then
ThreshValue = 113
End If
If ThreshNum = 83 Then
ThreshValue = 114
End If
If ThreshNum = 84 Then
ThreshValue = 115
End If
If ThreshNum = 85 Then
ThreshValue = 116
End If
If ThreshNum = 86 Then
ThreshValue = 117
End If
If ThreshNum = 87 Then
ThreshValue = 118
End If
If ThreshNum = 88 Then
ThreshValue = 119
End If
If ThreshNum = 89 Then
ThreshValue = 120
End If
If ThreshNum = 90 Then
ThreshValue = 121
End If
If ThreshNum = 91 Then
ThreshValue = 122
End If
If ThreshNum = 92 Then
ThreshValue = 123
End If
If ThreshNum = 93 Then
ThreshValue = 124
End If
If ThreshNum = 94 Then
ThreshValue = 125
End If
If ThreshNum = 95 Then
ThreshValue = 126
End If
If ThreshNum = 96 Then
ThreshValue = 127
End If
If ThreshNum = 97 Then
ThreshValue = 128
End If
If ThreshNum = 98 Then
ThreshValue = 129
End If
If ThreshNum = 99 Then
ThreshValue = 130
End If
If ThreshNum = 100 Then
ThreshValue = 131
End If
If ThreshNum = 101 Then
ThreshValue = 132
End If
If ThreshNum = 102 Then
ThreshValue = 133
End If
If ThreshNum = 103 Then
ThreshValue = 134
End If
If ThreshNum = 104 Then
ThreshValue = 135
End If
If ThreshNum = 105 Then
ThreshValue = 136
End If
If ThreshNum = 106 Then
ThreshValue = 137
End If
If ThreshNum = 107 Then
ThreshValue = 138
End If
If ThreshNum = 108 Then
ThreshValue = 139
End If
If ThreshNum = 109 Then
ThreshValue = 140
End If
If ThreshNum = 110 Then
ThreshValue = 141
End If
If ThreshNum = 111 Then
ThreshValue = 142
End If
If ThreshNum = 112 Then
ThreshValue = 143
End If
If ThreshNum = 113 Then
ThreshValue = 144
End If
If ThreshNum = 114 Then
ThreshValue = 145
End If
If ThreshNum = 115 Then
ThreshValue = 146
End If
If ThreshNum = 116 Then
ThreshValue = 147
End If
If ThreshNum = 117 Then
ThreshValue = 148
End If
If ThreshNum = 118 Then
ThreshValue = 149
End If
If ThreshNum = 119 Then
ThreshValue = 150
End If
If ThreshNum = 120 Then
ThreshValue = 151
End If
If ThreshNum = 121 Then
ThreshValue = 152
End If
If ThreshNum = 122 Then
ThreshValue = 153
End If
If ThreshNum = 123 Then
ThreshValue = 154
End If
If ThreshNum = 124 Then
ThreshValue = 155
End If
If ThreshNum = 125 Then
ThreshValue = 156
End If
If ThreshNum = 126 Then
ThreshValue = 157
End If
If ThreshNum = 127 Then
ThreshValue = 158
End If
If ThreshNum = 128 Then
ThreshValue = 159
End If
If ThreshNum = 129 Then
ThreshValue = 160
End If
If ThreshNum = 130 Then
ThreshValue = 161
End If
If ThreshNum = 131 Then
ThreshValue = 162
End If
If ThreshNum = 132 Then
ThreshValue = 163
End If
If ThreshNum = 133 Then
ThreshValue = 164
End If
If ThreshNum = 134 Then
ThreshValue = 165
End If
If ThreshNum = 135 Then
ThreshValue = 166
End If
If ThreshNum = 136 Then
ThreshValue = 167
End If
If ThreshNum = 137 Then
ThreshValue = 168
End If
If ThreshNum = 138 Then
ThreshValue = 169
End If
If ThreshNum = 139 Then
ThreshValue = 170
End If
If ThreshNum = 140 Then
ThreshValue = 171
End If
If ThreshNum = 141 Then
ThreshValue = 172
End If
If ThreshNum = 142 Then
ThreshValue = 173
End If
If ThreshNum = 143 Then
ThreshValue = 174
End If
If ThreshNum = 144 Then
ThreshValue = 175
End If
If ThreshNum = 145 Then
ThreshValue = 180
End If
If ThreshNum = 146 Then
ThreshValue = 185
End If
If ThreshNum = 147 Then
ThreshValue = 190
End If
If ThreshNum = 148 Then
ThreshValue = 100
End If
If ThreshNum = 149 Then
ThreshValue = 210
End If
If ThreshNum = 150 Then
ThreshValue = 220
End If
If ThreshNum = 151 Then
ThreshValue = 230
End If
If ThreshNum = 152 Then
ThreshValue = 240
End If
If ThreshNum = 153 Then
ThreshValue = 250
End If
If ThreshNum = 154 Then
ThreshValue = 250
End If

THold = ThreshValue
'*******************************************************************************************
' Open and Perform Calculations on ClipMosaic.txt files

For Rot3 = 1 to NumberRotations
 For Moscalc = 1 to NumIts
 fileName5 = Path2 & Rot3 & "_" & Moscalc & "_ClipMosaic" & ".tif"
Set ZDoc = appRef1.Open(fileName5)	
	ZDoc.ActiveLayer.Threshold THold  
	appRef1.DoAction "CliptoText", "C457.atn"
	fileName5 = Path2 & Rot3 & "_" & Moscalc & "_ClipMosaic" & ".txt"
	ZDoc.Close

 ' Define Applications to Be Used In Script
 Set xlsApp = Createobject("Excel.Application")
   With xlsApp
    xlsApp.Visible = True
    xlsApp.DisplayAlerts = False
    xlsApp.Workbooks.Open fileName5
   End With
 xlsApp.Rows("1:5").Select
 xlsApp.Selection.Insert Down 

 ' Insert Result Labels
 xlsApp.Range("A1").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Air Pix"
 xlsApp.Range("B1").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Other Pix"
 xlsApp.Range("C1").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Total Pix"

 ' Count Number Pixels defined as Air
 xlsApp.Range("A2").Select
 Formy1a = Ysel + 3
 Formy1 = "=COUNTIF(R[4]C:R[" & Formy1a & "]C[18],""=255"")"
 xlsApp.ActiveCell.FormulaR1C1 = Formy1

 ' Count Number Pixels defined as Other than Air
 xlsApp.Range("B2").Select
 Formy2 = "=COUNTIF(R[4]C[-1]:R[" & Formy1a & "]C[17],""=0"")"
 xlsApp.ActiveCell.FormulaR1C1 = Formy2

 ' Sum above counts to give total Pixels in Count
 xlsApp.Range("C2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=SUM(RC[-2]:RC[-1])"   

 ' Insert Result Labels
 xlsApp.Range("E1").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Air %"
 xlsApp.Range("F1").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Other %"
 xlsApp.Range("G1").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Total %"

 ' Calculate Percent Air From Count Data Above
 xlsApp.Range("E2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=100*(RC[-4]/RC[-2])"

 ' Calculate Percent Not Air From Count Data Above
 xlsApp.Range("F2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=100*(RC[-4]/RC[-3])"

 ' Sum above 2 values to verify they combine to 100%
 xlsApp.Range("G2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=SUM(RC[-2]:RC[-1])"

 ' Copy/Paste Calculated Values to cause cell values to be numerical, not formulae
 xlsApp.Range("A1:G2").Select
 xlsApp.Selection.Copy
 xlsApp.Range("A1:G2").Select
 xlsApp.Selection.pastespecial 12

 ' Calculate Number of Consecutive Air Pixels in Columnar Lines
 Formy3a = Ysel + 7
 Formy3 = "" & "A" & Formy3a & ""
 xlsApp.Range(Formy3).Select
 Formy4a = Ysel + 1
 Formy4 = "=IF(R[-" & Formy4a & "]C=0,0,(R[-" & Formy4a & "]C+(255*R[-1]C))/255)"
 xlsApp.ActiveCell.FormulaR1C1 = Formy4
 xlsApp.Range(Formy3).Select
 xlsApp.Selection.Copy
 Formy5b = (2*Ysel) + 6 
 Formy5 = "" & "A" & Formy3a & ":" & "S" & Formy5b & ""
 xlsApp.Range(Formy5).Select
 xlsApp.Activesheet.Paste

 ' Copy/Paste Calculated Values to cause cell values to be numerical, not formulae
 xlsApp.Range(Formy5).Select
 xlsApp.Selection.Copy
 xlsApp.Selection.pastespecial 12 

 ' Delete Unneeded Data Rows to reduce size of excel sheet
 Formy6a = Ysel + 5
 Formy6 = "" & "6" & ":" & Formy6a & ""
 xlsApp.Range(Formy6).Select
 xlsApp.Selection.Delete Up 

 ' Calculate the Length of Each Columnar Chord Intercept
 Formy7a = Ysel + 8
 Formy7 = "" & "A" & Formy7a & ""
 xlsApp.Range(Formy7).Select
 Formy8a = Ysel + 1
 Formy8 = "=IF(R[-" & Formy8a & "]C<=R[-" & Ysel & "]C,0,R[-" & Formy8a & "]C)"
 xlsApp.ActiveCell.FormulaR1C1 = Formy8
 xlsApp.Range(Formy7).Select
 xlsApp.Selection.Copy
 Formy9b = (2*Ysel) + 7 
 Formy9 = "" & "A" & Formy7a & ":" & "S" & Formy9b & ""
 xlsApp.Range(Formy9).Select
 xlsApp.Activesheet.Paste

 ' Copy/Paste Calculated Values to cause cell values to be numerical, not formulae
 xlsApp.Range(Formy9).Select
 xlsApp.Selection.Copy
 xlsApp.Selection.pastespecial 12 

 ' Delete Unneeded Data Rows to reduce size of excel sheet
 Formy10a = Ysel + 6
 Formy10 = "" & "7" & ":" & Formy10a & ""
 xlsApp.Range(Formy10).Select
 xlsApp.Selection.Delete Up

 ' Calculate total number air void intercepts
 xlsApp.Range("I2").Select
 Formy11a = Ysel + 5
 Formy11 = "=COUNTIF(R[6]C[-8]:R[" & Formy11a & "]C[10],"">0"")"
 xlsApp.ActiveCell.FormulaR1C1 = Formy11
 xlsApp.Range("I1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Tot.Int"

 ' Calculate number of pixels used in chord length calculations
 xlsApp.Range("J2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=RC[-7]"
 xlsApp.Range("J1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Trav.Pts"

 ' Display resolution per pixel of scanned image
 xlsApp.Range("K2").Select
 xlsApp.ActiveCell.FormulaR1C1 = Resolution
 xlsApp.Range("K1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Res/pixel"

 ' Calculate Total Length of Traverse Line
 xlsApp.Range("L2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=RC[-2]*RC[-1]*(10^-6)*(10^3)"
 xlsApp.Range("L1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Trav.(mm)"

 ' Calculate Number of Intercepts (voids) per mm of traverse line
 xlsApp.Range("M2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=RC[-4]/RC[-1]"
 xlsApp.Range("M1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Voids/mm" 

' Calculate (from Air % Value and Batch Weights) or Display (from input) Paste Percentage In Mix
If Datachunk = "pa" Then
   xlsApp.Range("S2").Select
   xlsApp.ActiveCell.FormulaR1C1 = PasteAggRatio
xlsApp.Range("N2").Select
   xlsApp.ActiveCell.FormulaR1C1 = "=(100-RC[-9])*((100*(RC[5]/(1+RC[5])))/100)"
Else
If Datachunk = "manualcount" Then
xlsApp.Range("S2").Select
   xlsApp.ActiveCell.FormulaR1C1 = NotAggPct
xlsApp.Range("N2").Select
   xlsApp.ActiveCell.FormulaR1C1 = "=RC[5]-RC[-9]" 
Else
If Datachunk = "pp" Then
   xlsApp.Range("N2").Select
   xlsApp.ActiveCell.FormulaR1C1 = Paste
 Else
If Datachunk = "ap" Then
   xlsApp.Range("S2").Select
   xlsApp.ActiveCell.FormulaR1C1 = NotAggPct
xlsApp.Range("N2").Select
   xlsApp.ActiveCell.FormulaR1C1 = "=RC[5]-RC[-9]" 
End If
 End If
End If
End If
 xlsApp.Range("N1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Paste %"

 ' Calculate Paste/Air Ratio
 xlsApp.Range("O2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=RC[-1]/RC[-10]"
 xlsApp.Range("O1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Paste/air" 

 ' Calculate Average Chord Length
 xlsApp.Range("P2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=RC[-11]/(100*RC[-3])"
 xlsApp.Range("P1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Chord L"

 ' Calculate Specific Surface Value
 xlsApp.Range("Q2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=(4/RC[-1])"
 xlsApp.Range("Q1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Sp.Surf"

 ' Calculate Spacing Factor
 xlsApp.Range("R2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=IF(RC[-3]<=4.342,RC[-4]/(400*RC[-5]),(3/RC[-1])*((1.4*((1+RC[-3])^(1/3)))-1))"
 xlsApp.Range("R1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Sp.factor"

 ' Add Row for Spacing
 xlsApp.Rows("7").Select
 xlsApp.Selection.Insert Down
 
 ' Set Up Ranges for Use in Creating Chord Length Freq. Chart
 xlsApp.Range("A3").Select
 xlsApp.ActiveCell.FormulaR1C1 = "1"
 xlsApp.Range("B3").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=1+RC[-1]"
 xlsApp.Range("B3").Select
 xlsApp.Selection.Copy
 xlsApp.Range("C3:IV3").Select
 xlsApp.ActiveSheet.Paste
 xlsApp.Range("A7").Select
 xlsApp.ActiveCell.FormulaR1C1 = Resolution
 xlsApp.Range("A7").Select
 xlsApp.Selection.Copy
 xlsApp.Range("A7:IV7").Select
 xlsApp.ActiveSheet.Paste
 xlsApp.Range("A4").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=R[3]C*R[-1]C"
 xlsApp.Range("A4").Select
 xlsApp.Selection.Copy
 xlsApp.Range("B4:IV4").Select
 xlsApp.Activesheet.Paste
 
ChordAnalysis = 0

If ChordAnalysis = 1 Then

 ' Count up Chord Lengths for Each Range Set up Previously (Range: 1-256 pixels)
 xlsApp.Range("A5").Select
 Formy12a = Ysel + 3
 Formy12 = "=COUNTIF(R[4]:R[" & Formy12a & "],R[-2]C)"
 xlsApp.ActiveCell.FormulaR1C1 = Formy12
 xlsApp.Range("A5").Select
 xlsApp.Selection.Copy
 xlsApp.Range("B5:IV5").Select
 xlsApp.Activesheet.Paste

End If
 
 ' Copy/Paste Calculated Values to cause cell values to be numerical, not formulae
 xlsApp.Range("A1:IV5").Select
 xlsApp.Selection.Copy
 xlsApp.Selection.pastespecial 12
 
 ' Delete Unneeded Data Rows to reduce size of excel sheet
 Formy13a = Ysel + 8
 Formy13 = "" & "7" & ":" & Formy13a & ""
 xlsApp.Range(Formy13).Select
 xlsApp.Selection.Delete Up
 xlsApp.Range("A1").Select
 
 ' Add Row for Spacing
 xlsApp.Rows("3").Select
 xlsApp.Selection.Insert Down
 xlsApp.Rows("5").Select

 DataAn = Rot3 & "_" & MosCalc & "_ClipMosaic"
 filenameJC = Path2 & "junkme.xls"

 xlsApp.Sheets(DataAn).Select
 xlsApp.Range("A1:IC6").Select
 xlsApp.Selection.Copy

 If Rot3 = 1 Then
  If MosCalc = 1 Then

   ' Create New Workbook to hold all data from analyses
     With xlsApp
      xlsApp.Visible = True
      xlsApp.DisplayAlerts = False
      xlsApp.Workbooks.Add
     End With
   xlsApp.Range("A1").Select
   xlsApp.Selection.pastespecial 12

 DataAn = Rot3 & "_" & MosCalc & "_ClipMosaic" & ".txt"

   xlsApp.Windows(DataAn).Activate
   xlsApp.ActiveWindow.Close
   xlsApp.Range("A5:IC6").Select
   xlsApp.Selection.Copy
   xlsApp.Range("T1").Select
   xlsApp.Selection.pastespecial 12
   xlsApp.Rows("4:6").Select
   xlsApp.Selection.Delete Up
   xlsApp.ActiveWindow.Close True,filenameJC
   xlsApp.Quit
Else

   ' Open Workbook to add data from analyses
    With xlsApp
     xlsApp.Visible = True
     xlsApp.DisplayAlerts = False
     xlsApp.Workbooks.Open filenameJC
    End With
   xlsApp.Range("A200").Select
   xlsApp.Selection.pastespecial 12

 DataAn = Rot3 & "_" & MosCalc & "_ClipMosaic" & ".txt"

   xlsApp.Windows(DataAn).Activate
   xlsApp.ActiveWindow.Close
   xlsApp.Range("A205:IC205").Select
   xlsApp.Selection.Copy
   xlsApp.Range("T201").Select
   xlsApp.Selection.pastespecial 12
   xlsApp.Range("A201:IV201").Select
   xlsApp.Selection.Copy
   xlsApp.Rows("2").Select
   xlsApp.Selection.Insert
   xlsApp.Rows("200:206").Select
   xlsApp.Selection.Delete Up
   xlsApp.Range("A1").Select
   xlsApp.ActiveWindow.Close True,filenameJC
   xlsApp.Quit
 End If
 Else

    ' Open Workbook to add data from analyses
    With xlsApp
     xlsApp.Visible = True
     xlsApp.DisplayAlerts = False
     xlsApp.Workbooks.Open filenameJC
    End With
   xlsApp.Range("A200").Select
   xlsApp.Selection.pastespecial 12

 DataAn = Rot3 & "_" & MosCalc & "_ClipMosaic" & ".txt"

   xlsApp.Windows(DataAn).Activate
   xlsApp.ActiveWindow.Close
   xlsApp.Range("A205:IC205").Select
   xlsApp.Selection.Copy
   xlsApp.Range("T201").Select
   xlsApp.Selection.pastespecial 12
   xlsApp.Range("A201:IV201").Select
   xlsApp.Selection.Copy
   xlsApp.Rows("2").Select
   xlsApp.Selection.Insert
   xlsApp.Rows("200:206").Select
   xlsApp.Selection.Delete Up
   xlsApp.Range("A1").Select
   xlsApp.ActiveWindow.Close True,filenameJC
   xlsApp.Quit
 End If
xlsApp.Quit
Next
Next


' Open Workbook to calculate overall results
Set xlsApp = CreateObject("Excel.Application")
 With xlsApp
  xlsApp.Visible = True
  xlsApp.DisplayAlerts = False
  xlsApp.Workbooks.Open filenameJC
 End With
 xlsApp.Rows("2:3").Insert
 xlsApp.Range("A2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=SUM(R[2]C:R[38]C)"
 xlsApp.Range("A3").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=AVERAGE(R[1]C:R[37]C)"
 xlsApp.Range("A2").Select
 xlsApp.Selection.Copy
 xlsApp.Range("B2:C2").Select
 xlsApp.ActiveSheet.Paste
 xlsApp.Range("I2:J2").Select
 xlsApp.ActiveSheet.Paste
 xlsApp.Range("T2:IV2").Select
 xlsApp.ActiveSheet.Paste
 xlsApp.Range("K2").Select
 xlsApp.ActiveCell.FormulaR1C1 = Resolution

'dude

' Calculate overall Percent Air
 xlsApp.Range("E2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=100*(RC[-4]/RC[-2])"

 ' Calculate overall Percent Not Air
 xlsApp.Range("F2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=100*(RC[-4]/RC[-3])"

 ' Sum above 2 values to verify they combine to 100%
 xlsApp.Range("G2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=SUM(RC[-2]:RC[-1])"

' Calculate (from Air % Value and Batch Weights) or Display (from input) Paste Percentage In Mix
If Datachunk = "pa" Then
   xlsApp.Range("S2").Select
   xlsApp.ActiveCell.FormulaR1C1 = PasteAggRatio
xlsApp.Range("N2").Select
   xlsApp.ActiveCell.FormulaR1C1 = "=(100-RC[-9])*((100*(RC[5]/(1+RC[5])))/100)"
Else
If Datachunk = "manualcount" Then
xlsApp.Range("S2").Select
   xlsApp.ActiveCell.FormulaR1C1 = NotAggPct
xlsApp.Range("N2").Select
   xlsApp.ActiveCell.FormulaR1C1 = "=RC[5]-RC[-9]"
Else
If Datachunk = "pp" Then
   xlsApp.Range("N2").Select
   xlsApp.ActiveCell.FormulaR1C1 = Paste
 Else
If Datachunk = "ap" Then
   xlsApp.Range("S2").Select
   xlsApp.ActiveCell.FormulaR1C1 = NotAggPct
xlsApp.Range("N2").Select
   xlsApp.ActiveCell.FormulaR1C1 = "=RC[5]-RC[-9]"
End If
End If
End If
End If

 xlsApp.Range("N1").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Paste %"

 ' Calculate overall Paste/Air Ratio
 xlsApp.Range("O2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=RC[-1]/RC[-10]"
 xlsApp.Range("O1").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Paste/air"

 ' Calculate Total Length of Traverse Line
 xlsApp.Range("L2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=RC[-2]*RC[-1]*(10^-6)*(10^3)"
 xlsApp.Range("L1").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Trav.(mm)"

 ' Calculate Number of Intercepts (voids) per mm of traverse line
 xlsApp.Range("M2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=RC[-4]/RC[-1]"
 xlsApp.Range("M1").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Voids/mm"

' Calculate overall Average Chord Length
 xlsApp.Range("P2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=RC[-11]/(100*RC[-3])"
 xlsApp.Range("P1").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Chord L"

 ' Calculate overall Specific Surface Value
 xlsApp.Range("Q2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=(4/RC[-1])"
 xlsApp.Range("Q1").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Sp.Surf"

 ' Calculate overall Spacing Factor
 xlsApp.Range("R2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=IF(RC[-3]<=4.342,RC[-4]/(400*RC[-5]),(3/RC[-1])*((1.4*((1+RC[-3])^(1/3)))-1))"
 xlsApp.Range("R1").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Sp.factor"

 xlsApp.Range("A3").Select
 xlsApp.Selection.Copy
 xlsApp.Range("B3:IV3").Select
 xlsApp.ActiveSheet.Paste
 xlsApp.Range("H2:H3").Select
 xlsApp.Selection.ClearContents
 xlsApp.Range("D2:D3").Select
 xlsApp.Selection.ClearContents
 xlsApp.Range("S3").Select
 xlsApp.Selection.ClearContents
 
 xlsApp.Range("A2:IV3").Select
 xlsApp.Selection.Copy
 xlsApp.Selection.PasteSpecial 12
 
 xlsApp.Range("T1:IV40").Select
 xlsApp.Selection.Copy
 xlsApp.Range("B41").Select
 xlsApp.Selection.PasteSpecial 12
 xlsApp.Range("A41").Select
 xlsApp.ActiveCell.FormulaR1C1 = "0"
 xlsApp.Range("A42").Select
 xlsApp.ActiveCell.FormulaR1C1 = "0"
 xlsApp.Range("T1:IV40").Select
 xlsApp.Selection.ClearContents
 xlsApp.Range("A2:R2").Select
 xlsApp.Selection.Copy


'compile results
xlsApp.Workbooks.Open OptThreshFile
xlsApp.Sheets(Defaultfile).Select
LocationA = "A" & ThreshNum + 1
LocationB = "B" & ThreshNum + 1
LocationC = "S" & ThreshNum + 1
LocationD = LocationB & ":" & LocationC
LocationE = "T" & Threshnum + 1
LocationF = "U" & Threshnum + 1
LocationG = "V" & Threshnum + 1
LocationH = "W" & Threshnum + 1

xlsApp.Range(LocationA).Select
xlsApp.ActiveCell.FormulaR1C1 = ThreshValue
xlsApp.Range(LocationD).Select
xlsApp.Selection.PasteSpecial 12
xlsApp.Range(LocationE).Select
AbsAir = "=ABS((" & ManAir & "-RC[-14])/RC[-14])"
xlsApp.ActiveCell.FormulaR1C1 = AbsAir
xlsApp.Range(LocationF).Select
AbsVoidFreq = "=ABS((" & ManVoidFreq & "-RC[-7])/RC[-7])"
xlsApp.ActiveCell.FormulaR1C1 = AbsVoidFreq
xlsApp.Range(LocationG).Select
xlsApp.ActiveCell.FormulaR1C1 = "=AVERAGE(RC[-2],RC[-1])"
xlsApp.Range(LocationH).Select
xlsApp.ActiveCell.FormulaR1C1 = "=RC[-22]"

xlsApp.Range("Z1").Select
xlsApp.ActiveCell.FormulaR1C1 = "=VLOOKUP(MIN(R[1]c[-6]:R[154]C[-6]),R[1]C[-6]:R[154]C[-3],4,FALSE)"

xlsApp.Range("AA1").Select
xlsApp.ActiveCell.FormulaR1C1 = "=VLOOKUP(MIN(R[1]c[-6]:R[154]C[-6]),R[1]C[-6]:R[154]C[-4],3,FALSE)"


xlsApp.Range("Y1").Select
xlsApp.ActiveCell.FormulaR1C1 = "=ROUND(AVERAGE(RC[1],RC[2]),0)"



xlsApp.ActiveWorkbook.Close True
xlsApp.ActiveWorkbook.Close True
xlsApp.Quit
Loop

'compile results, part 2

xlsApp.Workbooks.Open OptThreshFile
SummaryResults="Sheet1"
xlsApp.Sheets(Defaultfile).Select
xlsApp.Range("Y1").Select
xlsApp.Selection.Copy
xlsApp.Sheets(SummaryResults).Select
SumFileName = "A" & CellNum
MinValue = "B" & CellNum
xlsApp.Range(MinValue).select
xlsApp.Selection.pastespecial 12
xlsApp.Range(SumFileName).select
xlsApp.ActiveCell.FormulaR1C1 = Defaultfile
xlsApp.Range("B1").Select
xlsApp.ActiveCell.FormulaR1C1 = "=ROUND(AVERAGE(R[1]C:R[101]C),0)"
xlsApp.ActiveWorkbook.Close True
xlsApp.Quit

Loop