Check for data in every other column of a range.

[stirlingmw1]

Afternoon all

I hope I explain this right.

I have a worksheet that contains data from multiple shops and imported into the workbook to the worksheet "ImportData". This data then copied from "ImportData" into every other column of the worksheet "Main" using following code. The first 3 columns of the "Main" worksheet have "ID number", "category" and "item description" for multiple items, there are then 2 blank columns followed by the data from "importData" into every other column. This data is the qty of each item listed in the 1st 3 columns that is available across multiple stores with each store name in the first row of each imported column.

Sub AddDataToMain()

Dim ImpLRow As Long, MLRow As Long, i As Long
Dim wsI As Worksheet, wsM As Worksheet
Dim Ary As Variant

Set wsM = Worksheets("Main")
Set wsI = Worksheets("ImportData")

'Adds NSN ADAC and Description to Main page
ImpLRow = wsI.cells(Rows.Count, 1).End(xlUp).Row
MLRow = wsM.cells(Rows.Count, 1).End(xlUp).Row
Ary = wsI.Range("A4:BE" & ImpLRow).Value2

wsM.Range("A4:C" & ImpLRow).Value = Application.Index(Ary, Evaluate("row(1:" & ImpLRow - 3 & ")"), Array(1, 2, 3))
For i = 4 To UBound(Ary, 2)
   wsM.Range("E4:E" & ImpLRow).Offset(, (i - 3) * 2 - 1).Value = Application.Index(Ary, , i)
Next i


End Sub

The data is added as mentioned into every other column from F to BE leaving the blank column for me to annotate an qty of the items that I require to be moved from the store listed in the first row to another. I am trying to put some code together that if I have annotated a qty in any of the cells the blank columns the code copies the "ID number", "category" and "item description" into the first 3 columns of worksheet "Supplied_from" followed by the Qty I have annotated and then the Store Name from the top of the column which the Qty is annotated in, the code should loop through all of the rows from row 4 to Lastrow and copy data each time it encounters a Qty in one of the blank columns. If there are multiple Qtys in a row all Qtys and Store names should be annotated in the "Supplied_from" worksheet.

I know this is a big ask but hope you can help.

regards

Steve

 

[Fluff]

Could you post a small sample of your Main sheet.

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.

 

[stirlingmw1]

Could you post a small sample of your Main sheet.

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.

Store Uplift Tracker.xlsm
	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	AB	AC	AD	AE	AF	AG	AH	AI	AJ	AK	AL	AM	AN	AO	AP	AQ	AR	AS	AT	AU	AV	AW	AX	AY	AZ	BA	BB	BC	BD	BE	BF
1		UNIT	Bookers B			Bookers A		Bookers B		Lundi		Lipton		Chidngfold		CLYDE		Helensburgh		ROOKE		GRIMSBY		HURWORTH		LEDBURY		MERSEY		MIDDLETON		PEMBROKE		PENZANCE		RAMSEY		SEVERN		SHOREHAM		TYNE		Warehouse		Wilton		FORTH		MEDWAY		TRENT		SPEY		TAMAR
2						N4171A		N4107A		N0855A		N0853A		N0859A		N0890A		N8210A		N5380H		N8314A		N0861A		N0852A		N0889A		N0856A		N8313A		N7417A		N4109A		N0929A		N4170A		N0887A		MINOR WARSHIPS		N5314G		N0930A		N0931A		N0932A		N0934A		N0933A		Total
3	ID Number	Category	Item Description	Qty Required	Qty Achieved	Qty Held	Qty Needed	Qty Held	Qty Needed	Qty Held	Qty Needed	Qty Held	Qty Needed	Qty Held	Qty Needed	Qty Held	Qty Needed	Qty Held	Qty Needed	Qty Held	Qty Needed	Qty Held	Qty Needed	Qty Held	Qty Needed	Qty Held	Qty Needed	Qty Held	Qty Needed	Qty Held	Qty Needed	Qty Held	Qty Needed	Qty Held	Qty Needed	Qty Held	Qty Needed	Qty Held	Qty Needed	Qty Held	Qty Needed	Qty Held	Qty Needed	Qty Held	Qty Needed	Qty Held	Qty Needed	Qty Held	Qty Needed	Qty Held	Qty Needed	Qty Held	Qty Needed	Qty Held	Qty Needed	Qty Held	Qty Needed	Qty
4	1305-20-0007095	11203-07	Potatoes			231		639		0		539		797								338		538		0				18		374		580		0				595				15		16												4680
5	1305-99-8125230	11909-05	Carrots					900		0												0								2000												595		0		224		594		3594		593		555		593		9648
6	1305-99-7403969	11921-02	Apples			0		57		644		460		146				993		706		0		858		969		994		569		378		645		0		265		245		184		1		1		296		380		5640		1000		46		15477
7	1305-99-6021616	12007-07	Oranges	500	500	137		18295	200	0	100	17695		7544	100			5993	100	6994		19811		21493		4643		10118		17695		15994		6895		0		7720		4995		2719		0		698		5100		919		7524		6393		3124		192499
8	1305-99-3470328	12449-02	Grapes																									294										293				0		0		96								295				978
9	1310-99-6765121	12461-01	Mince																																									0		434		45		425		283		410		132		1729
10	1305-99-3844146	12463-02	Beetroot			194		185		44		84		69								145		244		106				184		293		135		0				25		53		225		98		56		53		54		55				2302
11	1370-12-3676172	13804-01	Tea																																							1		0		9				4		1						15
12	1375-99-2484203	50404-02	Coffee	10	10	5	2	0		6	4	6	4	2								0				53				24		2		3		0				0				0		0												101
13	1375-99-3824040	50603-05	Sugar			14		0		19		35		2								3		28		0				192		34		24		0				0				19		177												547
14	1375-99-5880670	51004-01	Yogurt - Plain																											2														0		4												6
15	1375-99-5771644	51010-11	Flour	2	2	1		0		1		1	1	0								0		1	1	0				3		2		2		0				0				0		1												12
16	1375-99-1525563	51301-09	Mint					0		0		2		0								2		1		2				3		2				0				0				1		1												14
17	9920-99-6654243	51403-02	Matches			1		1		0		2		1								0		2		0				6		2				0								0		0												15
18	1370-99-9627963	13030-02	BBQ Bricketts																																																			0
19	1305-19-0035057	12202-02	Pork			1		8		15		14		83				94		100		15		10		15		34		45		82		35		0		45		34				0		1				50		2100						2781
20	1370-12-3751347	42030-01	Beef					0				2		1								2		1		1				1														0		1												9
21	1340-12-3827481	12712-01	Lamb			7		9		0		3		0				10		10		5		7		0		10		16		10		8		0		6		10		6		4		30		0		11		22		13		10		207
22	1305-99-9586072	11916-02	Lettuce																							0																		0								10						10
23	1305-99-3278117	12015-27	Onion					200														0				8				130		1000										995		0		0		994		3172		1375		1775		1607		11256
24	1375-99-4889723	52418-01	Tyme					0		0		1		0								0		1		0				3		2				0				0				1		0												8
Main

Cell Formulas
Range	Formula
E4:E24	E4	=IF(SUM(G4,I4,K4,M4,O4,Q4,S4,U4,W4,Y4,AA4,AC4,AE4,AG4,AI4,AK4,AM4,AO4,AQ4,AS4,AU4,AW4,AY4,BA4,BC4,BE4)=0,"",SUM(G4,I4,K4,M4,O4,Q4,S4,U4,W4,Y4,AA4,AC4,AE4,AG4,AI4,AK4,AM4,AO4,AQ4,AS4,AU4,AW4,AY4,BA4,BC4,BE4))

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
E4:E40	Expression	=$E4<$D4	text	NO
F3:BE3	Cell Value	<>""""""	text	NO
D4:E40	Expression	=AND($D4=$E4,$D4>0)	text	NO
A4:BF40	Expression	=CELL("row")=ROW()	text	NO
A4:BF40	Expression	=$A4<>""	text	NO
A4:BF40	Expression	=$A4=""	text	NO
A4:C40	Cell Value	=""	text	NO
A4:C40	Cell Value	<>""	text	NO

Cells with Data Validation
Cell	Allow	Criteria
C1	List	=Units

 

[Fluff]

Thanks for that, how about

Sub stirlingmw()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long, nc As Long
   Dim Flg As Boolean
   
   With Sheets("Main")
      Ary = .Range("A1:BE" & .Range("A" & Rows.Count).End(xlUp).Row).Value2
   End With
   ReDim Nary(1 To UBound(Ary), 1 To UBound(Ary, 2))
   nc = 2
   For r = 4 To UBound(Ary)
      For c = 7 To UBound(Ary, 2) Step 2
         If Ary(r, c) <> "" Then
            If Not Flg Then nr = nr + 1
            Flg = True
            nc = nc + 2
            Nary(nr, 1) = Ary(r, 1)
            Nary(nr, 2) = Ary(r, 2)
            Nary(nr, 3) = Ary(r, 3)
            Nary(nr, nc) = Ary(1, c - 1)
            Nary(nr, nc + 1) = Ary(r, c)
         End If
      Next c
      Flg = False
      nc = 2
   Next r
   Sheets("Supplied_from").Range("A2").Resize(nr, UBound(Nary, 2)).Value = Nary
End Sub

 

[stirlingmw1]

Thanks for that, how about

Sub stirlingmw()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long, nc As Long
   Dim Flg As Boolean
  
   With Sheets("Main")
      Ary = .Range("A1:BE" & .Range("A" & Rows.Count).End(xlUp).Row).Value2
   End With
   ReDim Nary(1 To UBound(Ary), 1 To UBound(Ary, 2))
   nc = 2
   For r = 4 To UBound(Ary)
      For c = 7 To UBound(Ary, 2) Step 2
         If Ary(r, c) <> "" Then
            If Not Flg Then nr = nr + 1
            Flg = True
            nc = nc + 2
            Nary(nr, 1) = Ary(r, 1)
            Nary(nr, 2) = Ary(r, 2)
            Nary(nr, 3) = Ary(r, 3)
            Nary(nr, nc) = Ary(1, c - 1)
            Nary(nr, nc + 1) = Ary(r, c)
         End If
      Next c
      Flg = False
      nc = 2
   Next r
   Sheets("Supplied_from").Range("A2").Resize(nr, UBound(Nary, 2)).Value = Nary
End Sub

Fluff

Thank you, works exactly as I wanted. Your skills never stop impressing.

Regards

Stevee

 

[Fluff]

You're welcome & thanks for the feedback.