Attribute VB_Name = "subprograms"
Public Const decimalSeparator = ","
'Public Const micaExcelFolder As String = "C:\micaPythonCode\ForExcel\"
Public Const micaExcelFolder As String = "C:\micaThomas\"
Option Explicit
Dim DT As New DataTransfer
Sub selectFile()
Dim sgCode As Integer
Dim fileNumber As String
With ActiveSheet
If .Name = "C2_m" Then
 sgCode = 12
ElseIf .Name = "C2_c" Then
 sgCode = 15
ElseIf .Name = "P3_112" Then
 sgCode = 151
ElseIf .Name = "Pnmn" Then
 sgCode = 58
ElseIf .Name = "Ccmm" Then
 sgCode = 63
End If
fileNumber = .Cells(11, 25) 'Y11
End With
With DT
.spaceGroupCode = sgCode
.cifNumber = fileNumber
Call .transferAtomicCoordinates
Call .transferSymmGenerators
Call .transferReferenceText
End With
End Sub
Sub showReference()
Dim sgCode As Integer
Dim fileNumber As String
With ActiveSheet
If .Name = "C2_m" Then
 sgCode = 12
ElseIf .Name = "C2_c" Then
 sgCode = 15
ElseIf .Name = "P3_112" Then
 sgCode = 151
ElseIf .Name = "Pnmn" Then
 sgCode = 58
ElseIf .Name = "Ccmm" Then
 sgCode = 63
End If
fileNumber = .Cells(11, 25) 'Y11
End With
With DT
.spaceGroupCode = sgCode
.cifNumber = fileNumber
Call .transferReferenceText
End With
End Sub
Sub resetTargetCells()
'************************************************************************
' Resets numerical values in target cells to adjacent calculated values *
'************************************************************************
Dim nRange As Integer
Dim rangeAddress1(1 To 16) As String
Dim rangeAddress2(1 To 16) As String
Dim i As Integer
If ActiveSheet.Name = "C2_m" Or ActiveSheet.Name = "Ccmm" Then
nRange = 8
ElseIf ActiveSheet.Name = "C2_c" Or ActiveSheet.Name = "P3_112" Then
nRange = 10
ElseIf ActiveSheet.Name = "Pnmn" Then
nRange = 13
    rangeAddress1(10) = "S57:S59": rangeAddress2(10) = "T57:T59"
    rangeAddress1(11) = "S65:S67": rangeAddress2(11) = "T65:T67"
    rangeAddress1(12) = "S71:S72": rangeAddress2(12) = "T71:T72"
    rangeAddress1(13) = "V35:V35": rangeAddress2(13) = "W35:W35"
End If
'.................
    rangeAddress1(1) = "D8:D8": rangeAddress2(1) = "D9:D9"
    rangeAddress1(2) = "S9:S11": rangeAddress2(2) = "T9:T11"
    rangeAddress1(3) = "S17:S23": rangeAddress2(3) = "T17:T23"
    If ActiveSheet.Name = "Pnmn" Then
    rangeAddress1(2) = "S9:S12": rangeAddress2(2) = "T9:T12"
    End If
'..................
    If ActiveSheet.Name = "C2_m" Or ActiveSheet.Name = "Ccmm" Then
    rangeAddress1(4) = "S28:S30": rangeAddress2(4) = "T28:T30"
       If ActiveSheet.Name = "C2_m" Then
       rangeAddress1(5) = "S36:S38": rangeAddress2(5) = "T36:T38"
       Else
       rangeAddress1(5) = "S37:S39": rangeAddress2(5) = "T37:T39"
       End If
    rangeAddress1(6) = "S42:S44": rangeAddress2(6) = "T42:T44"
    rangeAddress1(7) = "V17:V24": rangeAddress2(7) = "W17:W24"
    rangeAddress1(8) = "S24:S24": rangeAddress2(8) = "T24:T24"
'...
    ElseIf ActiveSheet.Name = "C2_c" Or ActiveSheet.Name = "Pnmn" Then
    rangeAddress1(4) = "S26:S32": rangeAddress2(4) = "T26:T32"
    rangeAddress1(5) = "S37:S39": rangeAddress2(5) = "T37:T39"
       If ActiveSheet.Name = "C2_c" Then
       rangeAddress1(6) = "S44:S46": rangeAddress2(6) = "T44:T46"
       rangeAddress1(7) = "S50:S52": rangeAddress2(7) = "T50:T52"
       rangeAddress1(10) = "V35:V35": rangeAddress2(10) = "W35:W35"
       Else
       rangeAddress1(6) = "S45:S47": rangeAddress2(6) = "T45:T47"
       rangeAddress1(7) = "S51:S53": rangeAddress2(7) = "T51:T53"
       End If
    rangeAddress1(8) = "V17:V23": rangeAddress2(8) = "W17:W23"
    rangeAddress1(9) = "V26:V32": rangeAddress2(9) = "W26:W32"
    ElseIf ActiveSheet.Name = "P3_112" Then
    rangeAddress1(1) = "S26:S32": rangeAddress2(1) = "T26:T32" 'override
    rangeAddress1(4) = "S37:S39": rangeAddress2(4) = "T37:T39"
    rangeAddress1(5) = "S46:S48": rangeAddress2(5) = "T46:T48"
    rangeAddress1(6) = "S54:S56": rangeAddress2(6) = "T54:T56"
    rangeAddress1(7) = "S60:S62": rangeAddress2(7) = "T60:T62"
    rangeAddress1(8) = "V17:V23": rangeAddress2(8) = "W17:W23"
    rangeAddress1(9) = "V26:V32": rangeAddress2(9) = "W26:W32"
    rangeAddress1(10) = "V35:V35": rangeAddress2(10) = "W35:W35"
    End If
    For i = 1 To nRange
    Range(rangeAddress1(i)).Select
    Selection.Copy
    Range(rangeAddress2(i)).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Next i
End Sub
Sub calculateWeights()
Dim i As Integer
Dim factor As Double, criterium As Double
Dim denominator(1 To 12) As Double
factor = 100
criterium = 0.005
With ActiveSheet
If .Name = "C2_m" Then
denominator(1) = .Cells(9, 4).value 'trigonal deviation
denominator(2) = .Cells(9, 20).value 'IL volume
denominator(3) = .Cells(10, 20).value 'IL A(xy)
denominator(4) = .Cells(11, 20).value 'IL h
For i = 1 To 4
.Cells(9 + i, 30).value = factor / denominator(i)
Next i
'.......
For i = 1 To 7
denominator(i) = .Cells(16 + i, 22).value '7 auxiliary tetrahedral parameters
Next i
'...
For i = 1 To 7
If denominator(i) < criterium Then denominator(i) = criterium
.Cells(13 + i, 30).value = factor / .Cells(16 + i, 20).value '7 core tetrahedral parameters
.Cells(24 + i, 30).value = factor / denominator(i) '7 auxiliary tetrahedral parameters
Next i
'...octahedral volumes and areas
For i = 1 To 2
.Cells(20 + i, 30).value = factor / .Cells(27 + i, 20).value 'volume, area 1
.Cells(22 + i, 30).value = factor / .Cells(35 + i, 20).value 'volume, area 2
Next i
'...auxiliary octahedral parameters
denominator(1) = Abs(.Cells(41 + i, 20).value) 'Delta Z(central)
denominator(2) = .Cells(9, 20).value 'f(occ)
denominator(3) = .Cells(10, 20).value 'h(octahedral)
For i = 1 To 3
If denominator(i) < criterium Then denominator(i) = criterium
.Cells(31 + i, 30).value = factor / denominator(i)
Next i
End If 'Active Sheet complex block
End With
End Sub
Sub weightsUnity()
Dim i As Integer, startRow As Integer, endRow As Integer
With ActiveSheet
If .Name = "C2_m" Then
startRow = 10
endRow = 34
End If
For i = startRow To endRow
.Cells(i, 30).value = 1
Next i
End With
End Sub
