Creating Macro to order data within a cell uniformly and to entirely miss a row when one bit of data is missing

[abcdfgh]

Hi all,

Sorry am quite new to excel so if this is not explained very clearly please let me know.

I have a set of data made up of 15 columns and need to have them ordered in a certain way.

for each line in the original text of data 5 lines need to be created in the macro as follws

Line1: A&B&C, D&E, F&G&H, I (Where the & sign indicates that these should be joined together with the =& sign formula combining them)
Line2: A&B&C, J
Line3: A&B&C, K
Line4: A&B&C, L&M&N
Line5: A&B&C, O

Each line however must have all of the data within 1 cell but be space out in intervals.

Line1: A&B&C (starts from character one) , D&E(Starts from character 30) , F&G&H (starts from character 68) , I (starts from character 112)

Line2: A&B&C (starts from character one) , J (Starts from Character 112)

Line3: A&B&C (starts from character one) ,

K (Starts from Character 112)​

​

Line4: A&B&C (starts from character one) ,

L&M&N (Starts from Character 112)​

​

​

Line5: A&B&C (starts from character one) ,

O (Starts from Character 112)​

​

​

​

​

However in lines 2-5 code also needs to be imputed so that if any of the cells starting from character 112 are missing the whole row needs to be removed.

Therefore once I convert to a .dat file and put into WordPad it should look similar to the below image. As stated above the lines per original line will vary due to the omitting of blank cells.

The code that I managed to get to was as follows but is not correct and am quite stuck tbh and was done before the fifth line was added. Any help would be really appreciated. As previously stated i'm not sure how well I have explained the above so apologies. Thank you

Sub jkreynolds()
Dim Cl As Range
Dim WS As Worksheet
Dim NxtRw As Long

Set WS = Sheets("Macro")
NxtRw = 1
With Sheets("Data Extractor")
For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
WS.Range("A" & NxtRw).Resize(4).Value = Cl & Cl.Offset(, 1) & Cl.Offset(, 2)
WS.Range("B" & NxtRw).Value = Cl.Offset(, 3) & Cl.Offset(, 4)
WS.Range("C" & NxtRw).Value = Cl.Offset(, 5) & Cl.Offset(, 6) & Cl.Offset(, 7)
WS.Range("D" & NxtRw).Value = Cl.Offset(, 8)
WS.Range("B" & NxtRw + 1).Value = Cl.Offset(, 9)
WS.Range("B" & NxtRw + 2).Value = Cl.Offset(, 10) & Cl.Offset(, 11) & Cl.Offset(, 12)
WS.Range("B" & NxtRw + 3).Value = Cl.Offset(, 13)
NxtRw = NxtRw + 4
Next Cl
End With
Sheets("macro").Copy '
ActiveWorkbook.SaveAs Filename:=Environ("H:\") & "HKUDAT_", FileFormat:=xlCSV
ActiveWorkbook.Close
End Sub

 

[DanteAmor]

Try this

Sub Export_To_Txt()
  Dim FileNum As Long, i As Long, j As Long, k As Long
  Dim line1 As String, lineA As String, sFile As String
  
  FileNum = FreeFile()
  sFile = ThisWorkbook.Path & "\" & "HKUDAT_.csv"
  Open sFile For Output As #FileNum
  
  For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
    lineA = Range("A" & i) & Range("B" & i) & Range("C" & i)
    line1 = lineA & Space(29 - Len(lineA)) & Range("D" & i) & Range("E" & i)
    line1 = line1 & Space(67 - Len(line1)) & Range("F" & i) & Range("G" & i) & Range("H" & i)
    line1 = line1 & Space(111 - Len(line1)) & Range("I" & i)
    Print #FileNum, line1
    If Range("J" & i) <> "" Then Print #FileNum, lineA & Space(111 - Len(lineA)) & Range("J" & i)
    If Range("K" & i) <> "" Then Print #FileNum, lineA & Space(111 - Len(lineA)) & Range("K" & i)
    line1 = lineA & Space(111 - Len(lineA)) & Range("L" & i) & Range("M" & i) & Range("N" & i)
    If Range("L" & i) & Range("M" & i) & Range("N" & i) <> "" Then Print #FileNum, line1
    If Range("O" & i) <> "" Then Print #FileNum, lineA & Space(111 - Len(lineA)) & Range("O" & i)
  Next
  
  Close #FileNum
  MsgBox "Saved file: " & sFile
End Sub