Restructure old code

[rhino4eva]

So i have been using a vba code to fill an 12 columnsX 8 rows into columns of 8 form a list of 96 of one column
i need to modify the code to fill the the same 12 column x 8 Rows but now i need to fill horizontally into rows of 12
and each number will require 2 wells
eg
1
2
3
to become 1 1 2 2 3 3

the code is this

Sub RUNFILL()
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim rFound As Range
Set WS1 = Sheets("DATA")
Set WS2 = Sheets("BackingSheet")
For X = 3 To 99
With WS2.Range("c22:f45")
On Error Resume Next
target = WS1.Range("b" & X).Value
On Error Resume Next
Set rFound = .Find("*", SearchDirection=xlPrevious,SearchOrder=xl,ByColumns,L ookIn:xlValues)

On Error Goto 0
If InStr(target, "Probationary") <> sBPPdetect Then
ElseIf rFound Is Nothing Then
.Cells(1).Value = target
ElseIf Intersect(rFound, .Cells(.Rows.Count, .Columns.Count)) Is Nothing Then
If rFound.Row < .Rows(.Rows.Count).Row Then
rFound.Offset(1, 0).Value = target
Else
rFound.Offset(-.Rows.Count + 1, 1).Value = target
End If
End If
End With
Next X

 

[OaklandJim]

To get a better response try posting data using Mr Excel's excellent XL2BB add-in. See XL2BB - Excel Range to BBCode

If possible post a link to your workbook. Put it on Dropbox, Box, 1Drive, etc. then use the link icon above the message area. If necessary put fake but realistic data in the workbook.

 

[Skyybot]

What Platform and Office Version are you running, @rhino4eva ?

 

[rhino4eva]

grid.xls
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P
1	number				1	2	3	4	5	6	7	8	9	10	11	12
2	1			a	1	9	17	25
3	2			b	2	10	18	26
4	3		current code	c	3	11	19	27
5	4			d	4	12	20	28
6	5			e	5	13	21	29
7	6			f	6	14	22	30
8	7			g	7	15	23
9	8			h	8	16	24
10	9
11	10		single vertical mover form a colum to 8 x12 grid
12	11
13	12
14	13
15	14
16	15		new code		1	2	3	4	5	6	7	8	9	10	11	12
17	16			a	1	1	2	2	3	3	4	4	5	5	6	6
18	17			b	7	7	8	8	9	9	10	10	11	11	12	12
19	18			c	13	13	14	14	15	15	16	16	17	17	18	18
20	19			d	19	19	20	20	21	21	22	22	23	23	24	24
21	20			e	25	25	26	26	27	27	28	28	29	29	30	30
22	21			f	6	14	22	30
23	22			g	7	15	23
24	23			h	8	16	24
25	24
26	25		duplicate numbers from column a to 12x8 grid
27	26
28	27
29	28
30	29
31	30
Sheet1

 

[rhino4eva]

Sub currentRUNFILL()

Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim rFound As Range

Set WS1 = Sheets("Sheet1")
Set WS2 = Sheets("Sheet1")
Sheets("Sheet1").Range("e2:n9").ClearContents
For X = 2 To 97

With WS2.Range("e2:n9")
On Error Resume Next
target = WS1.Range("a" & X).Value
On Error Resume Next
Set rFound = .Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns, LookIn:=xlValues)
On Error GoTo 0
If rFound Is Nothing Then
.Cells(1).Value = target
ElseIf Intersect(rFound, .Cells(.Rows.Count, .Columns.Count)) Is Nothing Then
If rFound.Row < .Rows(.Rows.Count).Row Then
rFound.Offset(1, 0).Value = target
Else
rFound.Offset(-.Rows.Count + 1, 1).Value = target
End If
End If

End With


Next X

End Sub