Excel macro - Convert format - 2 cols onto multiple cols

Post Reply
wwj
Posts: 2497
Joined: 27 Jan 2007 08:16

Excel macro - Convert format - 2 cols onto multiple cols

Post by wwj »

Excel macro - Convert format - 2 cols onto multiple cols

Code: Select all


Sub ConvertFormat()
'
' Convert data format from 2 column for all wells onto two columns each obs. well
'

' Variables
    Dim filePath  As String
    Dim inputFile  As String
    Dim inputSheet  As String
    Dim stdWorkbook As String
    Dim dataSheet As String
    Dim AnalysisSheet As String
    Dim WellName As String
    
    Dim initRowPlot  As Integer
    
    Dim i  As Long
    Dim colNo  As Integer
    Dim rowNo  As Integer   ' -32,768 and 32,767
    Dim totalRow  As Long   ' -2,147,483,648 to 2,147,483,647
    
'   Basin Parameters.
    filePath = "E:\Projects\1965_Goldrush\05_Model\28_workDirTR\"
    inputFile = "TrTarget_Results_Exported.csv"
    inputSheet = "TrTarget_Results_Exported"
    AnalysisSheet = "AnalysisPlot"
    
    stdWorkbook = ActiveWorkbook.Name
    
'   [1] If needed, change an old result sheet. - Current workbook.
    For i = 1 To Worksheets.Count
        If Worksheets(i).Name = inputSheet Then
            exists = True
        End If
    Next i
    
    For i = 1 To Worksheets.Count
        If Worksheets(i).Name = "TrTarget_Results_Old" Then
        Application.DisplayAlerts = False
            Worksheets("TrTarget_Results_Old").Delete
            Application.DisplayAlerts = True
            i = Worksheets.Count + 1
        End If
    Next i
    
    If exists Then
        Worksheets(inputSheet).Select
        Worksheets(inputSheet).Name = "TrTarget_Results_Old"
    End If
    
'   [2] Import an output file: *.csv
    Workbooks.Open Filename:=filePath & inputFile
 
    Sheets(inputSheet).Select
    Sheets(inputSheet).Move Before:=Workbooks(stdWorkbook).Sheets(1)
    
'   [3] Re-arrange the input data
    dataSheet = "FormedData"
    
    exists = False
    For i = 1 To Worksheets.Count
        If Worksheets(i).Name = dataSheet Then
            exists = True
        End If
    Next i
    
    If Not exists Then
        Worksheets.Add().Name = dataSheet
    End If

    ' Clear all contents
    Worksheets(dataSheet).Cells.Clear
    
    totalRow = Sheets(inputSheet).Cells(Sheets(inputSheet).Rows.Count, "A").End(xlUp).Row
    rowNo = 1
    colNo = 1
    
    For i = 1 To totalRow
        If Not Worksheets(inputSheet).Cells(i, 1) = "" Then
            If Worksheets(inputSheet).Cells(i, 2) = "" And _
                Worksheets(inputSheet).Cells(i + 1, 2) = "Observed" Then
                
                rowNo = 1
                If i > 1 Then
                    colNo = colNo + 2
                End If
                
                Worksheets(dataSheet).Cells(rowNo, colNo) = _
                    Worksheets(inputSheet).Cells(i, 1)
                
            ElseIf Worksheets(inputSheet).Cells(i, 2) = "Observed" Then
                rowNo = 2
                Worksheets(dataSheet).Cells(rowNo, colNo) = "O.Tm(day)"
                Worksheets(dataSheet).Cells(rowNo, colNo + 1) = "Observed(ft)"
                
            ElseIf Worksheets(inputSheet).Cells(i, 2) = "Computed" Then
                rowNo = 2
                colNo = colNo + 2
                Worksheets(dataSheet).Cells(rowNo, colNo) = "M.Tm(day)"
                Worksheets(dataSheet).Cells(rowNo, colNo + 1) = "Modeled(ft)"
                
            Else
                Worksheets(dataSheet).Cells(rowNo, colNo) = _
                    Worksheets(inputSheet).Cells(i, 1)
                Worksheets(dataSheet).Cells(rowNo, colNo + 1) = _
                    Worksheets(inputSheet).Cells(i, 2)
            End If
            
            rowNo = rowNo + 1
        End If
    Next i

'   Back to the base.
    Sheets(AnalysisSheet).Select
    Range("A1").Select
    
End Sub

Post Reply