Use of VBA code or otherwise

[Jar888]

Hi there, is there a way to use VBA code or otherwise to make the left hand side look like the right as per the example excel snip I've attached?

I pull the data in at the moment as a block from another sheet into the left hand sides format. The only thing I really care about is the drill/single/twin/cut&drop numbers though. Everything else is mute. But the tricky part comes where the name might not match the heading in the same row. Generally speaking, each 4 rows of a machine are operated by the person at the top of the machine# and the others are just trainees.

 

[Jar888]

As an example of what the data looks like today, and a bit better color representation on which cells are associated with what;

 

[Dermot]

Try this code
Note it requires two cells to be named, to tell the code where to find the data, and where to put the result
The rangename topData must be given to the top left title cell for the data - in the example provided, it would be A1
The rangename Result must be given to the top left title cell where the result must go- in the example provided, it would be P1

To insert the code,

• go to the VBA editor (Alt F11)
• insert a code module from the Insert menu item
• a blank sheet comes up (if not blank, delete what is there)
• paste the code below
• assign the CollateData macro to your button

Option Explicit
Option Base 1

Sub CollateData()
  Dim D, rows, r, cols, c, sets, s, n
  With Range("topData")
    D = .Offset(1, 0).Resize(.End(xlDown).Row - .Row, .End(xlToRight).Column - .Column + 1)  'read in data
  End With
  rows = UBound(D, 1): sets = rows / 4  'get dimensions
  cols = UBound(D, 2)
  ReDim A(sets, cols)
 
  For s = 1 To sets 'for each set of 4 rows
    For r = 0 To 3 'for each row in set
      n = n + 1
      For c = 1 To cols 'for each col of that row
        If A(s, c) = "" And D(n, c) <> "" Then A(s, c) = D(n, c) 'insert value from data if not already set
      Next c
    Next r
  Next s
 
  With Range("Result").Offset(1, 0)
    .Resize(1000, cols).ClearContents
    .Resize(sets, cols) = A
  End With
 
End Sub

 

[Peter_SSs]

That would be a massive amount of typing for a helper to test with that actual sample data!
MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.


Here is another option to try with a copy of your workbook.

Sub Jar888()
  Dim rCrit As Range
  Dim lr As Long
  
  Set rCrit = Range("N1:N2")
  rCrit.Cells(2).Formula = "=COUNT(I2:L2)"
  lr = Range("A" & rows.Count).End(xlUp).Row
  Range("A1:L" & lr).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rCrit, CopyToRange:=Range("P1"), Unique:=False
  rCrit.ClearContents
  With Range("S2:S" & Range("P" & rows.Count).End(xlUp).Row)
    .Formula = Replace("=INDEX(D$2:D$#,MATCH(1,INDEX((C$2:C$#=R2)*(D$2:D$#<>""""),0),0))", "#", lr)
    .Value = .Value
  End With
End Sub

 

[Jar888]

Hey thanks for that! I feel dumb now for not doing this sooner.

Here's a post of above, below;

Test.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA
1	Date	Shift	Machine #	Operator	DH/UH	Heading	Plan	Diameter	Drill	Single	Twin	Cut & Drop				Date	Shift	Machine #	Operator	DH/UH	Heading	Plan	Diameter	Drill	Single	Twin	Cut & Drop
2	12/02/2022	DS	08156		UH			54mm								12/02/2022	DS	8159	Jamie	UH	45 EM 284 523 D DAC W1	INFILLS	54mm	12
3	12/02/2022	DS	08156		UH	SERVICE DAY		54mm								12/02/2022	DS	8159	Jamie	UH	52 OL 453 570 DPCB UH V1	D/P CABLES	54mm	63
4	12/02/2022	DS	08156		UH			54mm								12/02/2022	DS	8158	Sophie	UH	26 GRN 580-520-GSIN	# 8229 QBC STORE	54mm		152
5	12/02/2022	DS	08156		UH			54mm								12/02/2022	NS	8156	Kate	UH	57 CY 645 585 GSIN # 7968	INCYCLE CABLES	54mm	90	90
6	12/02/2022	DS	08159	Jamie	UH			54mm								12/02/2022	NS	8159	Nigel	UH	52 OL 453 570 DPCB UH V1	D/P CABLES	54mm	63	125.7
7	12/02/2022	DS	08159	Shane	UH	45 EM 284 523 D DAC W1	INFILLS	54mm	12							12/02/2022	NS	DRI004	Chris	UH	45 SCA 518-537-A-DDR-W1	CBS 1	54mm	90
8	12/02/2022	DS	08159		UH	52 OL 453 570 DPCB UH V1	D/P CABLES	54mm	63
9	12/02/2022	DS	08159		UH			54mm
10	12/02/2022	DS	08158	Sophie	UH	26 GRN 580-520-GSIN	# 8229 QBC STORE	54mm		152
11	12/02/2022	DS	08158	David	UH	57 CY 645 585 GSIN # 7968	INCYCLE CABLES	54mm
12	12/02/2022	DS	08158		UH			54mm
13	12/02/2022	DS	08158		UH			54mm
14	12/02/2022	DS	DRI004	Alex	UH	SERVICE DAY		54mm
15	12/02/2022	DS	DRI004		UH			54mm
16	12/02/2022	DS	DRI004	Willy	UH			54mm
17	12/02/2022	DS	DRI004	Tristan	UH			54mm
18
19	12/02/2022	NS	08156		UH	57 CY 645 585 GSIN # 7968	INCYCLE CABLES	54mm	90	90
20	12/02/2022	NS	08156	Kate	UH			54mm
21	12/02/2022	NS	08156		UH			54mm
22	12/02/2022	NS	08156		UH			54mm
23	12/02/2022	NS	08159		UH	52 OL 453 570 DPCB UH V1	D/P CABLES	54mm	63	125.7
24	12/02/2022	NS	08159	Nigel	UH			54mm
25	12/02/2022	NS	08159		UH			54mm
26	12/02/2022	NS	08159		UH			54mm
27	12/02/2022	NS	08158		UH			54mm
28	12/02/2022	NS	08158	Jake	UH			54mm
29	12/02/2022	NS	08158		UH			54mm
30	12/02/2022	NS	08158		UH			54mm
31	12/02/2022	NS	DRI004	Chris	UH	45 SCA 518-537-A-DDR-W1	CBS 1	54mm	90
32	12/02/2022	NS	DRI004		UH			54mm
33	12/02/2022	NS	DRI004	Jesse	UH			54mm
34	12/02/2022	NS	DRI004	Tarlea	UH			54mm
CB EXCTRACTOR

 

[Peter_SSs]

Thanks for the XL2BB sample. Given that, my previous code will not work. The sample data shows that the apparently vacant cells in columns I:L actually contain hidden zeros. Same with column D.

Further, I hadn't picked up that machine numbers may repeat further down column C. I will rethink my code and post again if I can come up with a solution.

 

[Peter_SSs]

See how this one goes. For that sample data in A:L it produces the same values as you have in P:AA.
Changed code lines highlighted

Sub Jar888()
  Dim rCrit As Range
  Dim lr As Long
  
  Set rCrit = Range("N1:N2")
  rCrit.Cells(2).Formula = "=COUNTIF(I2:L2,"">0"")"
  lr = Range("A" & rows.Count).End(xlUp).Row
  Range("A1:L" & lr).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rCrit, CopyToRange:=Range("P1"), Unique:=False
  rCrit.ClearContents
  With Range("S2:S" & Range("P" & rows.Count).End(xlUp).Row)
    .Formula = Replace("=INDEX(D$2:D$#,MATCH(1,INDEX((C$2:C$#=R2)*(D$2:D$#<>0)*(B$2:B#=Q2),0),0))", "#", lr)
    .Value = .Value
  End With
End Sub

 

[Jar888]

If it helps any, the machine numbers will always be in the same spot every time I pull the information. So rows 2 - 5 will always be assosciated with DS (Dayshift), 6-9 etc. etc.

Also, it's probably picking up hidden 0's as it's pulling the data from another sheet using;

='[ProdTrak CB SEC Sheet.xlsm]Shift Plan'!C25

Would changing it to the below solve this?;

=IFERROR(='[ProdTrak CB SEC Sheet.xlsm]Shift Plan'!C25,"")

 

[Peter_SSs]

Didn't the post #7 code work anyway?

 

[Jar888]

Sorry, no. I displayed the 6 dates at the start, then #N/A for operator and blank everything else.