Code: Select all
Sub make_TR_Targets_4GWV()
'
' make_TR_Targets_4GWV Macro
'
Dim listSht As String
Dim dataSht As String
Dim outputFN As String
Dim filePath As String
Dim totalWell As Integer
Dim numFieldData As Integer
Dim i As Integer
Dim j As Integer
Dim sp As Integer
Dim colWellID As Integer
Dim ctr As Integer
listSht = "TRTargetList"
dataSht = "Field_Data"
filePath = ActiveWorkbook.Path & "\\"
outputFN = "AE_TR_Targets_to_GWV.csv"
outputFN = filePath & outputFN
maxNumSP = 73
rowDataSht = 2 ' Heading row
colDataSht = 0 ' Heading column
rowListSht = 1 ' Heading row
col4Memo = 16
totalWell = Sheets(listSht).Cells(Sheets(listSht).Rows.Count, "D").End(xlUp).Row
totalWell = totalWell - rowListSht ' One line for heading
Sheets(listSht).Select
Sheets(listSht).Activate
Sheets(listSht).Cells(rowListSht, col4Memo) = "Running.."
Open outputFN For Output As #1
' Write a header into a file.
Write #1, "Name,X,Y,ScreenZ,TargetLayer,# of Data,Site"
ctr = 0
For i = (1 + rowListSht) To (totalWell + rowListSht)
col4ObsData = ctr * 2 + 1
wellID = Sheets(dataSht).Cells(1, col4ObsData)
colWellID = 0
' Write Well Info.
wlNm = Sheets(listSht).Cells(i, 2)
wlX = Sheets(listSht).Cells(i, 3)
wlY = Sheets(listSht).Cells(i, 4)
wlZ = Sheets(listSht).Cells(i, 5)
wlL = Sheets(listSht).Cells(i, 6)
wlSt = Sheets(listSht).Cells(i, 9)
numFieldData = Sheets(dataSht).Cells(Sheets(dataSht).Rows.Count, col4ObsData).End(xlUp).Row
numFieldData = numFieldData - rowDataSht
If wellID = wlNm Then
Sheets(listSht).Cells(i, col4Memo) = "Ok"
Write #1, wlNm, wlX, wlY, wlZ, wlL, numFieldData, wlSt
For sp = 1 To numFieldData
tm = Sheets(dataSht).Cells(sp + rowDataSht, col4ObsData)
Hw = Sheets(dataSht).Cells(sp + rowDataSht, col4ObsData + 1)
' Write data.
Write #1, tm, Hw, 1
Next sp
ctr = ctr + 1
Else
Sheets(listSht).Cells(i, col4Memo) = "Missing Data"
End If
Next i
Close #1
Sheets(listSht).Cells(rowListSht, col4Memo) = " Done!"
Sheets(listSht).Cells(rowListSht, col4Memo).Select
' Message box
MsgBox "Done for writing : " & ctr & " target wells! "
End Sub