PDA

View Full Version : 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.
mdmackillop
07-25-2010, 11:22 PM
Can you put these results into a workbook and post it?
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