Divide the Column Data using VBA

**chinnu123** · 07-22-2010, 03:04 AM

I have been searching for a VBA code on the internet to split Data based on first column vlaues and fill it in different Column ranges.split suppose to happen while importing the delimited(!) text file.
Text file has the following column.
A!REFDES!PIN_NUMBER!NET_NAME!NET_ETCH_LENGTH!

I am leaving out A column and importing Rest of the column into excel sheet.

Assume my Text file have this data,
REFDES!PIN_NUMBER!NET_NAME!NET_ETCH_LENGTH!
DUT!H41!DDR3_DQ[19]!9498.34!
DUT!H42!DDR3_DQ[23]!9498.02!
J1!AX2!GND!333256.77!
J80!DS3!NOA_AVRB_STB[0]!7573.99!
C459!1!LDP1-16_VTT!7660.31!

In REFDES column you can see different type of data among those i need split DUT and J1-J80 values in specified Ranges in excel sheet.split would be like follows.
REFDES!PIN_NUMBER!NET_NAME!NET_ETCH_LENGTH!
DUT!H41!DDR3_DQ[19]!9498.34!
DUT!H42!DDR3_DQ[23]!9498.02!
REFDES!PIN_NUMBER!NET_NAME!NET_ETCH_LENGTH!
J1!AX2!GND!333256.77!
J80!DS3!NOA_AVRB_STB[0]!7573.99!

I don't know too much about VBA but I'm learning..I am here with attaching Excel file and Text file.
Your help would be much appreciated ..

**Aussiebear** · 07-22-2010, 11:15 AM

Your file is password protected, so any code provided cannot be tested with your data

**chinnu123** · 07-22-2010, 08:45 PM

Apologies i am re attching the file

**mdmackillop** · 07-24-2010, 02:16 AM

Can you show an expected result? I'm not totally clear on what is required.

**bkgashok** · 07-24-2010, 07:26 AM

present code is splitting the text as per the ! delimit... what more is required...

**chinnu123** · 07-25-2010, 09:47 PM

Thanks for your reply.
Assume my text file Having following data
REFDES!PIN_NUMBER!NET_NAME!NET_ETCH_LENGTH!
DUT!H41!DDR3_DQ[19]!9498.34!
DUT!H42!DDR3_DQ[23]!9498.02!
J1!AX2!GND!333256.77!
J80!DS3!NOA_AVRB_STB[0]!7573.99!
C459!1!LDP1-16_VTT!7660.31!

I want to Split DUT(RED) values in one Range of cells and J1 to J80 (Blue)values in one range of cells as shown in follwing way i dont need rest of the values/data from text file...split suppose to happen when i click a selectfile by cliking button..for every text file values of DUT and J1 to J80 is common.

DUT values shoud be populated in Range of columnA,B,C,D
REFDES!PIN_NUMBER!NET_NAME!NET_ETCH_LENGTH!
DUT!H41!DDR3_DQ[19]!9498.34!
DUT!H42!DDR3_DQ[23]!9498.02!

where as J1 to J80 values should be populated in range of columns E,F,G,H
REFDES!PIN_NUMBER!NET_NAME!NET_ETCH_LENGTH!
J1!AX2!GND!333256.77!
J80!DS3!NOA_AVRB_STB[0]!7573.99!
Above split should happen whaen i select Text file.

**chinnu123** · 07-25-2010, 11:46 PM

Thanks Gentleman.
Assume my text file Having following data
REFDES!PIN_NUMBER!NET_NAME!NET_ETCH_LENGTH!
DUT!H41!DDR3_DQ[19]!9498.34!
DUT!H42!DDR3_DQ[23]!9498.02!
J1!AX2!GND!333256.77!
J80!DS3!NOA_AVRB_STB[0]!7573.99!
C459!1!LDP1-16_VTT!7660.31!

I am here with attching the Excel sheet as mentioned i put the results in worksheet.

**GTO** · 07-26-2010, 05:11 AM

Greetings,

I came up with this before seeing that last attachment at #8. This lays out one below the other. Try:

Option Explicit
    
Sub Main3()
Dim _
FSO             As Object, _
fsoTStream      As Object, _
DIC             As Object, _
aryTemp         As Variant, _
aryHeader       As Variant, _
aryRawJagged    As Variant, _
aryOutput       As Variant, _
arySub          As Variant, _
strTemp         As String, _
lRowCount       As Long, _
i               As Long, _
x               As Long, _
y               As Long, _
j               As Long, _
lElement        As Long
    
    ChDrive Left(ThisWorkbook.Path, 1)
    ChDir ThisWorkbook.Path
    
    strTemp = Application.GetOpenFilename(FileFilter:="Text Files (*.txt), *.txt", _
                                          Title:="Please select a Text file")
    If strTemp = "False" Then Exit Sub
    
    Set DIC = CreateObject("Scripting.Dictionary")
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    '                                         ForReading, False, TristateUseDefault
    Set fsoTStream = FSO.OpenTextFile(strTemp, 1, False, &HFFFFFFFE)
    
    With fsoTStream
        
        strTemp = .ReadLine
        aryTemp = Split(strTemp, "!")
               
        aryHeader = aryTemp
        For i = LBound(aryHeader, 1) To UBound(aryHeader, 1) - 1
            aryHeader(i) = aryHeader(i + 1)
        Next
        ReDim Preserve aryHeader(LBound(aryHeader, 1) To UBound(aryHeader, 1) - 1)
        
        ReDim aryRawJagged(1 To 2, 0 To 0)
        
        Do While Not .AtEndOfStream
            
            strTemp = .ReadLine
            If InStr(1, strTemp, "!") = 0 Then
                GoTo JumpLoop
            End If
            aryTemp = Split(strTemp, "!")
            
            If Not aryTemp(1) = "DUT" _
            And Not (aryTemp(1) Like "J[1-9]" Or aryTemp(1) Like "J[1-8][0-9]") Then
                GoTo JumpLoop
            End If
            
            If Not DIC.Exists(aryTemp(1)) Then
                
                DIC.Item(aryTemp(1)) = aryTemp(1)
                
                ReDim Preserve aryRawJagged(1 To 2, 1 To UBound(aryRawJagged, 2) + 1)
                aryRawJagged(1, UBound(aryRawJagged, 2)) = aryTemp(1)
                
                ReDim arySub(1 To 3, 1 To 1)
                aryRawJagged(2, UBound(aryRawJagged, 2)) = arySub
                
                aryRawJagged(2, UBound(aryRawJagged, 2))(1, 1) = aryTemp(2)
                aryRawJagged(2, UBound(aryRawJagged, 2))(2, 1) = aryTemp(3)
                aryRawJagged(2, UBound(aryRawJagged, 2))(3, 1) = aryTemp(4)
            Else
                lElement = Application.Match(aryTemp(1), DIC.Items, 0)
                
                arySub = aryRawJagged(2, lElement)
                ReDim Preserve arySub(1 To 3, 1 To UBound(arySub, 2) + 1)
                aryRawJagged(2, lElement) = arySub
                
                aryRawJagged(2, lElement)(1, UBound(arySub, 2)) = aryTemp(2)
                aryRawJagged(2, lElement)(2, UBound(arySub, 2)) = aryTemp(3)
                aryRawJagged(2, lElement)(3, UBound(arySub, 2)) = aryTemp(4)
            End If
JumpLoop:
        Loop
        .Close
    End With
    
    lRowCount = 1
    
    For i = LBound(aryRawJagged, 2) To UBound(aryRawJagged, 2)
        
        arySub = aryRawJagged(2, i)
        ReDim aryTemp(1 To UBound(arySub, 2), 1 To 3)
        
        For x = 1 To UBound(aryTemp, 1)
            lRowCount = lRowCount + 1
            For y = 1 To 3
                aryTemp(x, y) = arySub(y, x)
            Next
        Next
        
        aryRawJagged(2, i) = aryTemp
    Next
    
    ReDim aryOutput(1 To lRowCount, 1 To 4)
    
    aryOutput(1, 1) = aryHeader(0)
    aryOutput(1, 2) = aryHeader(1)
    aryOutput(1, 3) = aryHeader(2)
    aryOutput(1, 4) = aryHeader(3)
    
    i = 1: x = 0: y = 0: j = 0
    
    Do While i < lRowCount
    
        j = j + 1
        aryOutput(i + 1, 1) = aryRawJagged(1, j)
        arySub = aryRawJagged(2, j)
        For x = LBound(arySub, 1) To UBound(arySub, 1)
            i = i + 1
            For y = LBound(arySub, 2) To UBound(arySub, 2)
                aryOutput(i, y + 1) = arySub(x, y)
            Next
        Next
    Loop
    
    With Range("A1").Resize(UBound(aryOutput, 1), UBound(aryOutput, 2))
        .Value = aryOutput
        .Rows(1).Font.Bold = True
        .EntireColumn.AutoFit
    End With
End Sub

Does that help?

Mark

**chinnu123** · 07-26-2010, 10:28 PM

Excellent GTO,Pretty accurate solution,Thanks.

**GTO** · 07-27-2010, 09:55 AM

You are most welcome. I happen to spot you initial response/advise about it not laying out side-by side, and was still interested in seeing if I could speed it up a bit.

Try:

Option Explicit
    
Enum RefDesCond
    DutExists = -4
    DutNotExists = -1
    JNumExists = -7
    JNumNotExists = -2
End Enum
    
Sub Main3()
Dim _
FSO             As Object, _
fsoTStream      As Object, _
DIC             As Object, _
DIC2            As Object, _
aryTemp         As Variant, _
aryHeader       As Variant, _
aryRawJagged    As Variant, _
aryOutput       As Variant, _
arySub          As Variant, _
arySub2         As Variant, _
strTemp         As String, _
lRowCount       As Long, _
lRowCount2      As Long, _
i               As Long, _
x               As Long, _
y               As Long, _
j               As Long, _
lElement        As Long, _
lUBDim          As Long, _
bolSlotExists   As Boolean
    
    ChDrive Left(ThisWorkbook.Path, 1)
    ChDir ThisWorkbook.Path
    
    strTemp = Application.GetOpenFilename(FileFilter:="Text Files (*.txt), *.txt", _
                                          Title:="Please select a Text file")
    If strTemp = "False" Then Exit Sub
    
    Set DIC = CreateObject("Scripting.Dictionary")
    Set DIC2 = CreateObject("Scripting.Dictionary")
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set fsoTStream = FSO.OpenTextFile(strTemp, 1, False, &HFFFFFFFE)
    
    With fsoTStream
        
        strTemp = .ReadLine
        aryTemp = Split(strTemp, "!")
        aryHeader = aryTemp
        
        For i = LBound(aryHeader, 1) To UBound(aryHeader, 1) - 1
            aryHeader(i) = aryHeader(i + 1)
        Next
        
        ReDim Preserve aryHeader(LBound(aryHeader, 1) To UBound(aryHeader, 1) - 1)
        ReDim aryRawJagged(1 To 4, 0 To 0)
        
        Do While Not .AtEndOfStream
            
            strTemp = .ReadLine
            If InStr(1, strTemp, "!") = 0 Then
                GoTo JumpLoop
            End If
            aryTemp = Split(strTemp, "!")
            
            Select Case (aryTemp(1) = "DUT") + _
                         ((aryTemp(1) Like "J[1-9]" Or aryTemp(1) Like "J[1-8][0-9]") * 2) + _
                         (DIC.Exists(aryTemp(1)) * 3) + _
                         (DIC2.Exists(aryTemp(1)) * 5)
                         
            Case DutExists
                
                ReDim aryRow(LBound(aryRawJagged, 2) To UBound(aryRawJagged, 2))
                
                For i = LBound(aryRawJagged, 2) To UBound(aryRawJagged, 2)
                    aryRow(i) = aryRawJagged(i, 1)
                Next
                
                lElement = Application.Match(aryTemp(1), aryRow, 0)
                
                arySub = aryRawJagged(2, lElement)
                ReDim Preserve arySub(1 To 3, 1 To UBound(arySub, 2) + 1)
                aryRawJagged(2, lElement) = arySub
                
                aryRawJagged(2, lElement)(1, UBound(arySub, 2)) = aryTemp(2)
                aryRawJagged(2, lElement)(2, UBound(arySub, 2)) = aryTemp(3)
                aryRawJagged(2, lElement)(3, UBound(arySub, 2)) = aryTemp(4)
    
            Case DutNotExists
                
                DIC.Item(aryTemp(1)) = aryTemp(1)
                
                If UBound(aryRawJagged, 2) = 0 Then
                    ReDim Preserve aryRawJagged(1 To 4, 1 To UBound(aryRawJagged, 2) + 1)
                    lElement = UBound(aryRawJagged, 2)
                Else
                    ReDim aryRow(LBound(aryRawJagged, 2) To UBound(aryRawJagged, 2))
                    
                    For i = LBound(aryRawJagged, 2) To UBound(aryRawJagged, 2)
                        If aryRawJagged(1, i) = Empty Then
                            lElement = i
                            bolSlotExists = True
                            Exit For
                        End If
                    Next
                    
                    If bolSlotExists Then
                        bolSlotExists = False
                    Else
                        ReDim Preserve aryRawJagged(1 To 4, 1 To UBound(aryRawJagged, 2) + 1)
                        lElement = UBound(aryRawJagged, 2)
                    End If
                End If
                
                aryRawJagged(1, lElement) = aryTemp(1)
                
                ReDim arySub(1 To 3, 1 To 1)
                aryRawJagged(2, lElement) = arySub
                
                aryRawJagged(2, lElement)(1, 1) = aryTemp(2)
                aryRawJagged(2, lElement)(2, 1) = aryTemp(3)
                aryRawJagged(2, lElement)(3, 1) = aryTemp(4)
    
            Case JNumExists
                
                ReDim aryRow(LBound(aryRawJagged, 2) To UBound(aryRawJagged, 2))
                
                For i = LBound(aryRawJagged, 2) To UBound(aryRawJagged, 2)
                    aryRow(i) = aryRawJagged(3, i)
                Next
                
                lElement = Application.Match(aryTemp(1), aryRow, 0)
                
                arySub2 = aryRawJagged(4, lElement)
                ReDim Preserve arySub2(1 To 3, 1 To UBound(arySub2, 2) + 1)
                aryRawJagged(4, lElement) = arySub2
                
                aryRawJagged(4, lElement)(1, UBound(arySub2, 2)) = aryTemp(2)
                aryRawJagged(4, lElement)(2, UBound(arySub2, 2)) = aryTemp(3)
                aryRawJagged(4, lElement)(3, UBound(arySub2, 2)) = aryTemp(4)
                
            Case JNumNotExists
            
                DIC2.Item(aryTemp(1)) = aryTemp(1)
                
                If UBound(aryRawJagged, 2) = 0 Then
                    ReDim Preserve aryRawJagged(1 To 4, 1 To UBound(aryRawJagged, 2) + 1)
                    lElement = UBound(aryRawJagged, 2)
                Else
                    ReDim aryRow(LBound(aryRawJagged, 2) To UBound(aryRawJagged, 2))
    
                    For i = LBound(aryRawJagged, 2) To UBound(aryRawJagged, 2)
                        If aryRawJagged(3, i) = Empty Then
                            lElement = i
                            bolSlotExists = True
                            Exit For
                        End If
                    Next
                    
                    If bolSlotExists Then
                        bolSlotExists = False
                    Else
                        ReDim Preserve aryRawJagged(1 To 4, 1 To UBound(aryRawJagged, 2) + 1)
                        lElement = UBound(aryRawJagged, 2)
                    End If
                End If
                
                aryRawJagged(3, lElement) = aryTemp(1)
                
                ReDim arySub2(1 To 3, 1 To 1)
                aryRawJagged(4, lElement) = arySub2
                
                aryRawJagged(4, lElement)(1, 1) = aryTemp(2)
                aryRawJagged(4, lElement)(2, 1) = aryTemp(3)
                aryRawJagged(4, lElement)(3, 1) = aryTemp(4)
            End Select
JumpLoop:
        Loop
        .Close
    End With
    
    lRowCount = 1
    i = 1
    Do While Not IsEmpty(aryRawJagged(1, i))
        lRowCount = lRowCount + UBound(aryRawJagged(2, i), 2)
        i = i + 1
        If i = UBound(aryRawJagged, 2) Then Exit Do
    Loop
    
    lRowCount2 = 1 + lRowCount
    i = 1
    Do While Not IsEmpty(aryRawJagged(3, i))
        lRowCount2 = lRowCount2 + UBound(aryRawJagged(4, i), 2)
        i = i + 1
        
        If i = UBound(aryRawJagged, 2) Then Exit Do
    Loop
    
    ReDim aryOutput(1 To lRowCount + lRowCount2, 1 To 8)
    
    lUBDim = 0
    For i = 1 To UBound(aryRawJagged, 2)
        If IsEmpty(aryRawJagged(1, i)) Then
            lUBDim = i - 1
            Exit For
        End If
    Next
    If lUBDim = 0 Then lUBDim = UBound(aryRawJagged, 2)
    
    For i = 1 To lUBDim
        
        arySub = aryRawJagged(2, i)
        ReDim aryTemp(1 To UBound(arySub, 2), 1 To 3)
        
        For x = 1 To UBound(aryTemp, 1)
            For y = 1 To 3
                aryTemp(x, y) = arySub(y, x)
            Next
        Next
        
        aryRawJagged(2, i) = aryTemp
    Next
    
    i = 1: x = 0: y = 0: j = 0
    Do While i < lRowCount
    
        j = j + 1
        aryOutput(i + 1, 1) = aryRawJagged(1, j)
        arySub = aryRawJagged(2, j)
        For x = LBound(arySub, 1) To UBound(arySub, 1)
            i = i + 1
            For y = LBound(arySub, 2) To UBound(arySub, 2)
                aryOutput(i, y + 1) = arySub(x, y)
            Next
        Next
    Loop
    
    lUBDim = 0
    For i = 1 To UBound(aryRawJagged, 2)
        If IsEmpty(aryRawJagged(3, i)) Then
            lUBDim = i - 1
            Exit For
        End If
    Next
    If lUBDim = 0 Then lUBDim = UBound(aryRawJagged, 2)
    
    For i = 1 To lUBDim
        
        arySub = aryRawJagged(4, i)
        ReDim aryTemp(1 To UBound(arySub, 2), 1 To 3)
        
        For x = 1 To UBound(aryTemp, 1)
            For y = 1 To 3
                aryTemp(x, y) = arySub(y, x)
            Next
        Next
        
        aryRawJagged(4, i) = aryTemp
    Next
    
    i = 1: x = 0: y = 0: j = 0
    Do While i < lRowCount2
    
        j = j + 1
        aryOutput(i + 1, 1 + 4) = aryRawJagged(3, j)
        arySub = aryRawJagged(4, j)
        For x = LBound(arySub, 1) To UBound(arySub, 1)
            i = i + 1
            For y = LBound(arySub, 2) To UBound(arySub, 2)
                aryOutput(i, y + 5) = arySub(x, y)
            Next
        Next
    Loop
    
    aryOutput(1, 1) = aryHeader(0)
    aryOutput(1, 2) = aryHeader(1)
    aryOutput(1, 3) = aryHeader(2)
    aryOutput(1, 4) = aryHeader(3)
    aryOutput(1, 5) = aryHeader(0)
    aryOutput(1, 6) = aryHeader(1)
    aryOutput(1, 7) = aryHeader(2)
    aryOutput(1, 8) = aryHeader(3)
    
    With Range("A1").Resize(UBound(aryOutput, 1), UBound(aryOutput, 2))
        .Value = aryOutput
        .Rows(1).Font.Bold = True
        .EntireColumn.AutoFit
    End With
End Sub

Hope that helps,

Mark

**chinnu123** · 07-27-2010, 11:20 PM

Yes GTO that was my initial response/requirement,laying side by side,Based on your logic i managed to acheive that in different way, i am happy to share with that.Once again Thanks for another solution.

Private Function GetPinList()
On Error Resume Next
Set objReport = New Report
strFileContent = objReport.GetReport(ActiveWorkbook.Path & "\" & "NetName.txt")
myArray = Split(strFileContent, vbLf)
myArrayLength = UBound(myArray) - LBound(myArray) + 1
ExcelRow = 10
For i = 0 To myArrayLength - 1 Step 1
If myArray(i) <> "" And Mid(myArray(i), 1, 2) = "S!" Then
If Split(myArray(i), "!")(1) = "DUT" Then
Sheet2.Range("D" & ExcelRow) = Split(myArray(i), "!")(1) 'A range is a group or block of cells in a worksheet that have been selected or highlighted
Sheet2.Range("E" & ExcelRow) = Split(myArray(i), "!")(2)
Sheet2.Range("F" & ExcelRow) = Split(myArray(i), "!")(3)
Sheet2.Range("G" & ExcelRow) = Split(myArray(i), "!")(4)
End If
If Split(myArray(i), "!")(1) Like "J[1-9]" Or Split(myArray(i), "!")(1) Like "J[1-8][0-9]" Then
Sheet2.Range("L" & ExcelRow) = Split(myArray(i), "!")(1)
Sheet2.Range("M" & ExcelRow) = Split(myArray(i), "!")(2)
Sheet2.Range("N" & ExcelRow) = Split(myArray(i), "!")(3)
End If
With Sheet2 'With Executes a series of statements on a single object
.Range("H" & ExcelRow) = Split(myArray(i), "!")(3)
.Range("I" & ExcelRow) = Split(myArray(i), "!")(4)
End With
ExcelRow = ExcelRow + 1
End If
Next i
End Function

Thread: Divide the Column Data using VBA

Thread Tools

Display

Divide the Column Data using VBA

Posting Permissions