Excel macro - Trim & String and etc.

[wwj]

My example.

Code: Select all

Sub ExtractUnique()

'
' Extract data of unique wells.
'

' Variables

    Dim inSheet  As String
    Dim wellSheet  As String
    Dim outSheet As String
    Dim str1 As String
    Dim str2 As String
    
    Dim initRowPlot  As Integer
    
    Dim i  As Long
    Dim j  As Long
    
    Dim swNew As Boolean
    
    Dim totData  As Long   ' -2,147,483,648 to 2,147,483,647
    Dim totList  As Long
    Dim rowNo  As Long
    Dim totWell  As Long
    Dim WellCtr  As Long
    
'   Basin Parameters.
    inSheet = "Targets_Transient_v02"
    wellSheet = "TargetList"
    outSheet = "UniList"
    
    actWB = ActiveWorkbook.Name
    
    totData = Sheets(inSheet).Cells(Sheets(inSheet).Rows.Count, "B").End(xlUp).Row
    totList = Sheets(wellSheet).Cells(Sheets(wellSheet).Rows.Count, "A").End(xlUp).Row

    Sheets(inSheet).Select
    Range("A1:F2").Activate
    Selection.Copy
    
    Sheets(outSheet).Select
    Cells(1, 1).Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
         False, Transpose:=False
    
    rowNo = 1
    totWell = 0
    WellCtr = 1
    swNew = False
    
    For i = 2 To totData

        If Not Sheets(inSheet).Cells(i, 1) = "" Then
        
            swNew = False
            For j = 2 To totList
                str1 = Trim(CStr(Sheets(inSheet).Cells(i, 1)))
                str2 = Trim(CStr(Sheets(wellSheet).Cells(j, 1)))
                
                If str1 = str2 Then
                    
                    Sheets(outSheet).Cells(WellCtr, 8) = WellCtr
                    Sheets(outSheet).Cells(WellCtr + 1, 9) = Sheets(inSheet).Cells(i, 1)
                
                    swNew = True
                    totWell = totWell + 1
                    WellCtr = WellCtr + 1
                End If
            Next j
        End If
        
        If swNew Then
            Sheets(outSheet).Cells(rowNo, 1) = Sheets(inSheet).Cells(i, 1)
            Sheets(outSheet).Cells(rowNo, 2) = Sheets(inSheet).Cells(i, 2)
            Sheets(outSheet).Cells(rowNo, 3) = Sheets(inSheet).Cells(i, 3)
            Sheets(outSheet).Cells(rowNo, 4) = Sheets(inSheet).Cells(i, 4)
            rowNo = rowNo + 1
        End If
    
    Next i
    
    ' Format
    Sheets(outSheet).Select
    Cells(2, 5) = totWell
    Cells(2, 6).NumberFormat = "mm/dd/yy"
    Range("B:B").NumberFormat = "mm/dd/yy"
    Range("C:C").NumberFormat = "0.00"

End Sub