-
Notifications
You must be signed in to change notification settings - Fork 0
/
NEB_macro
151 lines (107 loc) · 4.12 KB
/
NEB_macro
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
Private Sub CommandButton1_Click()
Dim sh As Worksheet
Dim rw As Range
Dim RowCount As Integer
Dim final_bool As Boolean
Dim initial_bool As Boolean
Dim initial_count As String
Dim final_count As String
Dim barrier As Double
Dim barrier_Cell As String
Dim rng As String 'Range of image energies for determinning activiation barrier
Dim final_cell() As String 'Hold string for MAX()
Dim initial_cell() As String 'Holds string for MAX()
Dim reactants_cell() As String
Dim reactants_cell_int As Integer
Dim reactants_cell_str As String
'Dynamic Array
Dim barrier_arr() As Variant
Dim barrier_cell_string_arr() As Variant
Dim X As Long
RowCount = 0
final_bool = "False"
initial_bool = "True"
Set sh = ActiveSheet
For Each rw In sh.Rows
If Left(rw.Text, 1) = "/" Then
If final_bool = "True" Then
final_count = rw.Address
reactants_cell_int = Count2Int(initial_count, 1) 'Obtain integer portion of reactantsa cell. (i.e is $A$12 is image 0 then Count2int_initial gives back 12)
reactants_cell_str = Count2Cell(initial_count, 1)
barrier_cell_str = "B" + CStr(reactants_cell_int) 'Location of where to place barrier height, where "reactants_cell_int" is the integer part of the cell location. (i.e $A$13-> 13)
rng = Count2Cell(initial_count, 1) + ":" + Count2Cell(final_count, -1)
barrier = GetMax(rng) - Range(reactants_cell_str).Value 'Value of barrier
Call RedMax(rng) 'Transition State Energy gets highlighted Red
'Store barrier double and barrier cell location (to be wrriten) in arrays
ReDim Preserve barrier_arr(X)
ReDim Preserve barrier_cell_string_arr(X)
barrier_arr(X) = barrier
barrier_cell_string_arr(X) = barrier_cell_str
X = X + 1
Call CreateChart(rng)
initial_bool = "True"
final_bool = "False"
End If
If initial_bool = "True" Then
initial_count = rw.Address
initial_bool = "False"
final_bool = "True"
End If
End If
If sh.Cells(rw.Row, 1).Value = "" Then
Call Allocate_barrier(barrier_arr, barrier_cell_string_arr)
Exit For
End If
Next rw
End Sub
Function GetMax(rng) As Double
'This function find the max within a range.
GetMax = WorksheetFunction.Max(Range(rng))
End Function
Function Count2Int(count As String, i As Integer) As Integer
'This fucntion takes a string cell address and returns the integer portion plus/minus one.(i.e if Cell is $A$12, the function returns "13" for i = 1
cell = Split(count, ":")
Count2Int = CInt(cell(1)) + i
End Function
Function Count2Cell(count As String, i As Integer) As String
'This function takes a string cell address and returns a string cell below/above it depending on "i".
cell = Split(count, ":")
Count2Cell = "A" + CStr(Count2Int(count, i))
End Function
Function AddressOfMax(rng As Range) As String
'This function returns the string address of the cell with the largest value within a range.
AddressOfMax = WorksheetFunction.Index(rng, WorksheetFunction.Match(WorksheetFunction.Max(rng), rng, 0)).Address
End Function
Sub Allocate_barrier(barrier_values, barrier_cells)
'This subroutine prints values into adjacent cells to the NEB ranges.
Dim j As Integer
For j = 0 To UBound(barrier_values)
'MsgBox barrier_values(j)
'MsgBox barrier_cells(j)
Range(barrier_cells(j)).Value = barrier_values(j)
Next j
End Sub
Sub RedMax(rng)
'This subroutine changes the font color of the maximum within a range to red.
Dim Address_Max As String
Dim range_input As Range
Set range_input = Range(rng)
Address_Max = AddressOfMax(range_input)
Range(Address_Max).Font.Color = vbRed
End Sub
Sub CreateChart(rng)
'This subroutine creates the charts. The chart position and dimensions are modified here. Ensure that the range (rng) has only values!!!
Dim cht As Object
Dim reactant As String
Dim product As String
'Create a chart
Set cht = ActiveSheet.ChartObjects.Add( _
Left:=100, _
Width:=250, _
Top:=Range(rng).Top, _
Height:=Range(rng).Height)
'Give data to chart
cht.Chart.SetSourceData Source:=ActiveSheet.Range(rng)
'Determine chart type
cht.Chart.ChartType = xlXYScatterSmooth
End Sub