I have this VBA code, but for some reason I can't extract the PID ITEM Description (PIDF08***GENTLE MONSTER BLCK HORNET~
Here is the code:
Sub TransformData()
Dim wsOriginal As Worksheet
Set wsOriginal = ThisWorkbook.Worksheets("RAW") ' Change to your sheet name
Dim wsTransformed As Worksheet
Set wsTransformed = ThisWorkbook.Worksheets("Transformed") ' Change to your sheet name
Dim lastRow As Long
lastRow = wsOriginal.Cells(wsOriginal.Rows.Count, "A").End(xlUp).Row
Dim data As Variant
data = wsOriginal.Range("A1:A" & lastRow).Value
Dim table As Variant
ReDim table(1 To UBound(data), 1 To 30) ' Adjusted for 30 fields (added CTP fields)
Dim i As Long
Dim j As Long
j = 1
Dim docNum As String
Dim dateTransmitted As String
Dim vendorName As String
Dim vendorAddress As String
Dim vendorCity As String
Dim vendorState As String
Dim vendorZip As String
Dim dtm010 As String
Dim dtm001 As String
Dim pidDescription As String
Dim ctpValue As String
' Clear the output worksheet before writing new data
wsTransformed.Cells.Clear
' Write column names in the first row
wsTransformed.Range("A1").Value = "Document Number"
wsTransformed.Range("B1").Value = "Date Transmitted"
wsTransformed.Range("C1").Value = "Vendor Name"
wsTransformed.Range("D1").Value = "Vendor Address"
wsTransformed.Range("E1").Value = "Vendor City"
wsTransformed.Range("F1").Value = "Vendor State"
wsTransformed.Range("G1").Value = "Vendor Zip"
wsTransformed.Range("H1").Value = "FOB"
wsTransformed.Range("I1").Value = "DF"
wsTransformed.Range("J1").Value = "DTM"
wsTransformed.Range("K1").Value = "DTM Qualifier"
wsTransformed.Range("L1").Value = "DTM Date"
wsTransformed.Range("M1").Value = "DTM Qualifier"
wsTransformed.Range("N1").Value = "DTM Qualifier"
wsTransformed.Range("O1").Value = "DTM Date"
wsTransformed.Range("P1").Value = "PO1 Item Number"
wsTransformed.Range("Q1").Value = "PO1 Quantity"
wsTransformed.Range("R1").Value = "Unit of Measure"
wsTransformed.Range("S1").Value = "Price"
wsTransformed.Range("T1").Value = "Vendor Item Number"
wsTransformed.Range("U1").Value = "Item Type"
wsTransformed.Range("V1").Value = "Additional Vendor Item Number"
wsTransformed.Range("W1").Value = "Additional Item Type"
wsTransformed.Range("X1").Value = "PID"
wsTransformed.Range("Y1").Value = "PID Qualifier"
wsTransformed.Range("Z1").Value = "PID Item Description"
wsTransformed.Range("AA1").Value = "CTP Value" ' New CTP column
wsTransformed.Range("AB1").Value = "CTP Qualifier" ' New CTP Qualifier column
For i = 1 To UBound(data)
' Remove ~ from the data
Dim cleanData As String
cleanData = Replace(data(i, 1), "~", "")
If InStr(cleanData, "BEG*00*SA*") > 0 Then
docNum = Split(cleanData, "*")(3)
dateTransmitted = Split(cleanData, "*")(5)
ElseIf InStr(cleanData, "N1*ST*") > 0 Then
vendorName = Split(cleanData, "*")(2)
vendorAddress = Split(data(i + 1, 1), "*")(0)
vendorCity = Split(data(i + 2, 1), "*")(1)
vendorState = Split(data(i + 2, 1), "*")(2)
vendorZip = Split(data(i + 2, 1), "*")(3)
ElseIf InStr(cleanData, "DTM*010*") > 0 Then
dtm010 = Split(cleanData, "*")(2)
ElseIf InStr(cleanData, "DTM*001*") > 0 Then
dtm001 = Split(cleanData, "*")(2)
ElseIf InStr(cleanData, "PO1*") > 0 Then
' Extract PO1 details
Dim poParts() As String
poParts = Split(cleanData, "*")
table(j, 1) = docNum
table(j, 2) = dateTransmitted
table(j, 3) = vendorName
table(j, 4) = vendorAddress
table(j, 5) = vendorCity
table(j, 6) = vendorState
table(j, 7) = vendorZip
table(j, 8) = "FOB" ' Static value
table(j, 9) = "DF" ' Static value
table(j, 10) = "DTM" ' Static value
table(j, 11) = "010" ' Static value
table(j, 12) = dtm010 ' DTM date from earlier
table(j, 13) = "DTM" ' Static value
table(j, 14) = "001" ' Static value
table(j, 15) = dtm001 ' DTM date from earlier
' Extract PO1 details
If InStr(cleanData, "PO1*") > 0 Then
' Extract PO1 details using Split
table(j, 16) = Split(cleanData, "*")(1) ' PO1 Item Number
table(j, 17) = Split(cleanData, "*")(2) ' PO1 Quantity
table(j, 18) = Split(cleanData, "*")(3) ' Unit of Measure
table(j, 19) = Split(cleanData, "*")(4) ' Price
End If
' Extract Vendor Item Number and Item Type safely
Dim parts() As String
parts = Split(cleanData, "*")
If UBound(parts) >= 7 Then
table(j, 20) = Trim(Replace(parts(7), "~", "")) ' Vendor Item Number (remove ~)
Else
table(j, 20) = "" ' Handle missing value
End If
If UBound(parts) >= 8 Then
table(j, 21) = Trim(Replace(parts(8), "~", "")) ' Item Type (remove ~)
Else
table(j, 21) = "" ' Handle missing value
End If
If UBound(parts) >= 9 Then
table(j, 22) = Trim(Replace(parts(9), "~", "")) ' Additional Vendor Item Number (if applicable, remove ~)
Else
table(j, 22) = "" ' Handle missing value
End If
If UBound(parts) >= 10 Then
table(j, 23) = Trim(Replace(parts(10), "~", "")) ' Additional Item Type (if applicable, remove ~)
Else
table(j, 23) = "" ' Handle missing value
End If
' Initialize PID description
pidDescription = ""
' Move to the next line to look for PID*F*
i = i + 1
' Loop to find PID*F* lines
Do While i <= UBound(data) And InStr(data(i, 1), "PID*F*") > 0
Dim pidParts() As String
pidParts = Split(data(i, 1), "*")
' Check if there are enough parts to extract the description
If UBound(pidParts) >= 4 Then
' Extract the description from the 4th part (index 4)
pidDescription = Trim(Replace(pidParts(7), "~", "")) ' Capture description and remove ~
End If
i = i + 1 ' Move to the next line
Loop
table(j, 24) = "PID" ' Static value
table(j, 25) = "F" ' Static value
table(j, 26) = Trim(pidDescription) ' PID Item Description
' Check for CTP details
If InStr(data(i, 1), "CTP**") > 0 Then
Dim ctpParts() As String
ctpParts = Split(data(i, 1), "*")
If UBound(ctpParts) >= 2 Then
ctpValue = Trim(Replace(ctpParts(2), "~", "")) ' CTP Value
table(j, 27) = ctpValue ' Store CTP Value
End If
If UBound(ctpParts) >= 3 Then
table(j, 28) = Trim(Replace(ctpParts(3), "~", "")) ' CTP Qualifier
End If
End If
j = j + 1 ' Move to the next row in the table
End If
Next i
' Write the transformed data starting from row 2
wsTransformed.Range("A2:AB" & j).Value = table ' Adjusted to AB for 30 columns
' Create a table from the data
Dim tbl As ListObject
Set tbl = wsTransformed.ListObjects.Add(xlSrcRange, wsTransformed.Range("A1:AB" & j - 1), , xlYes)
tbl.Name = "TransformedData" ' Name the table
tbl.TableStyle = "TableStyleMedium9" ' Optional: Set a table style
' Format column B (Date Transmitted) as mm/dd/yyyy hh:mm
wsTransformed.Columns(2).NumberFormat = "mm/dd/yyyy hh:mm"
' Format columns L and O (DTM Date) as mm/dd/yyyy
wsTransformed.Columns(12).NumberFormat = "mm/dd/yyyy"
wsTransformed.Columns(15).NumberFormat = "mm/dd/yyyy"
' Autofit columns for better visibility
wsTransformed.Columns.AutoFit
End Sub
to populate the PID Description column on my excel file.
Try revising the logic here
' Loop to find PID*F* lines
Do While i <= UBound(data)
If Left(data(i, 1), 6) = "PID*F*" Then
Dim pidParts() As String
pidParts = Split(data(i, 1), "*")
' Check if there are enough parts to extract the description
If UBound(pidParts) >= 4 Then
' Extract the description from the 4th part (index 4)
pidDescription = Trim(Replace(pidParts(7), "~", "")) ' Capture description and remove ~
End If
Exit Do
Else
i = i + 1 ' Move to the next line
End If
Loop