Split in to multiple columns based on row value

[mattdavid.hall]

Hello,

We have an interesting situation where an old system outputs data in to a CSV that looks as shown in this image:

We need to split this in to multiple columns. It's hard for me to easily describe the end result, so here is a picture of what we want:

I can easily take an excel file and create some IF statements to move data over to column F-T, but I don't know if I can, or how to automatically delete the blank cells and move the data UP as shown.

Are there any easy ways that I can do what we're looking for?

Thanks as always!

 

[maabadi]

if your data is in Sheet1 ( Otherwise Change Sheet1 at code to your Sheet Name) and Start from Row 1, Try this and see result at Sheet2 :

Sub Test()
Dim i As Long, Lr As Long, Ws1 As Worksheet, Ws2 As Worksheet, K As Long, Lr2 As Long
Set Ws1 = Sheets("Sheet1")
On Error Resume Next
Set Ws2 = Sheets("Sheet2")
If Err.Number = 9 Then
Worksheets.Add After:=ActiveSheet
Set Ws2 = ActiveSheet
End If
On Error GoTo 0
Lr = Ws1.Range("A" & Rows.Count).End(xlUp).Row
Ws1.Range("A1:A" & Lr).TextToColumns Destination:=Ws1.Range("A1"), DataType:=xlDelimited, Comma:=True
If Range("D1").Value <> "" Then Columns("B:B").EntireColumn.Delete
Ws1.Range("D1").Value = "Distinct"
Ws1.Range("D2:D" & Lr).Formula = "=IFERROR(INDEX($B$1:$B$" & Lr & ",MATCH(0,INDEX(COUNTIF($D$1:D1,$B$1:$B$" & Lr & "),0,0),0)),"""")"
For i = 1 To Lr
K = Application.WorksheetFunction.Match(Ws1.Range("B" & i), Ws1.Range("D2:D" & Lr), 0)
Lr2 = Ws2.Cells(Rows.Count, K * 3).End(xlUp).Row + 1
Range(Ws2.Cells(Lr2, K * 3 - 2), Ws2.Cells(Lr2, K * 3)).Value = Ws1.Range("A" & i & ":C" & i).Value
Next i

End Sub

 

[Peter_SSs]

I suggest that you update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

 

[mattdavid.hall]

Sub Test() Dim i As Long, Lr As Long, Ws1 As Worksheet, Ws2 As Worksheet, K As Long, Lr2 As Long Set Ws1 = Sheets("Sheet1") On Error Resume Next Set Ws2 = Sheets("Sheet2") If Err.Number = 9 Then Worksheets.Add After:=ActiveSheet Set Ws2 = ActiveSheet End If On Error GoTo 0 Lr = Ws1.Range("A" & Rows.Count).End(xlUp).Row Ws1.Range("A1:A" & Lr).TextToColumns Destination:=Ws1.Range("A1"), DataType:=xlDelimited, Comma:=True If Range("D1").Value <> "" Then Columns("B:B").EntireColumn.Delete Ws1.Range("D1").Value = "Distinct" Ws1.Range("D2:D" & Lr).Formula = "=IFERROR(INDEX($B$1:$B$" & Lr & ",MATCH(0,INDEX(COUNTIF($D$1:D1,$B$1:$B$" & Lr & "),0,0),0)),"""")" For i = 1 To Lr K = Application.WorksheetFunction.Match(Ws1.Range("B" & i), Ws1.Range("D2:D" & Lr), 0) Lr2 = Ws2.Cells(Rows.Count, K * 3).End(xlUp).Row + 1 Range(Ws2.Cells(Lr2, K * 3 - 2), Ws2.Cells(Lr2, K * 3)).Value = Ws1.Range("A" & i & ":C" & i).Value Next i End Sub

Thank you for the help!
When we run this script we receive an error "Method 'Range' of object '_Worksheet' failed"

The script creates Sheet2 but it is blank. It does created the Distinct column on Sheet1 with the distinct values from Column B and it is accurate. I'll dig in to this code today and see if I can figure out what's going on. I do appreciate the direction!

 

[mattdavid.hall]

I suggest that you update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

Updated, thank you!

 

[Peter_SSs]

Updated, thank you!

Thanks for that.

Since yo have 365, could you use something like this?
The formula in F2 is copied and pasted into I2, L2, O2 and R2 only

mattdavid.hall.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
1						REG			OT			VAC			REG3			REG2
2	2495		VAC	48.08		2340	REG	12.9	2367	OT	19.37	2495	VAC	48.08	2386	REG3	13.27	2480	REG2	26.82
3	2340		REG	12.9		2323	REG	26.2	2496	OT	25.75	2337	VAC	12.61	2422	REG3	18.79	2419	REG2	10.62
4	2367		OT	19.37		2442	REG	19.51	2326	OT	25.1	2443	VAC	10.35	2351	REG3	37.79	2334	REG2	49.16
5	2386		REG3	13.27		2421	REG	46.6				2423	VAC	19.42				2386	REG2	12.87
6	2480		REG2	26.82														2374	REG2	40.89
7	2337		VAC	12.61														2476	REG2	21.22
8	2419		REG2	10.62
9	2443		VAC	10.35
10	2334		REG2	49.16
11	2323		REG	26.2
12	2496		OT	25.75
13	2442		REG	19.51
14	2421		REG	46.6
15	2386		REG2	12.87
16	2374		REG2	40.89
17	2422		REG3	18.79
18	2326		OT	25.1
19	2476		REG2	21.22
20	2423		VAC	19.42
21	2351		REG3	37.79
22
Sheet1

Cell Formulas
Range	Formula
F2:H5,R2:T7,O2:Q4,L2:N5,I2:K4	F2	=INDEX(FILTER($A$2:$D$21,$C$2:$C$21=F1),SEQUENCE(COUNTIF($C$2:$C$21,F1)),{1,3,4})
Dynamic array formulas.

 

[mattdavid.hall]

Range	Formula
Cell Formulas
F2:H5,R2:T7,O2:Q4,L2:N5,I2:K4	F2	=INDEX(FILTER($A$2:$D$21,$C$2:$C$21=F1),SEQUENCE(COUNTIF($C$2:$C$21,F1)),{1,3,4})
Dynamic array formulas.

Peter, that is awesome and it worked perfectly!

Thank you so much my dude!

 

[Peter_SSs]

You're welcome. Thanks for the follow-up.

BTW, if you have the LET function you can write the existing formula ..

=INDEX(FILTER($A$2:$D$21,$C$2:$C$21=F1),SEQUENCE(COUNTIF($C$2:$C$21,F1)),{1,3,4})

.. marginally more compactly as

=LET(f,FILTER($A$2:$D$21,$C$2:$C$21=F1),INDEX(f,SEQUENCE(ROWS(f)),{1,3,4}))