Improve VBA transferring cell formatting & values

[Lil Stinker]

I'm trying to build an inventory management application, so the setup is a bit complicated. My question has two parts.

I have three worksheets:
- Sheet1 "Receipt" is a form that contains a list of barcodes numbers for returned items being checked in by the user
- Sheet2 "Record" is the log where the barcode data for every return receipt generated is stored on the back end
- Sheet3 "Inventory" is where every barcode in inventory is stored and updated in or out based on the return receipt

Current process:
On the Receipt form, when a user checks in an existing barcode, the cell color with the matching barcode is changed to vbYellow, the font is changed to bold, and a diagonal line is added to "cross out" that number. If the item coming back is damaged, the cell color is changed to vbRed. For any barcode that is not returned, the font remains light grey. Previous return cells are shaded grey with white font. The visual differentiation is relevant to the user and the customer.

Book1.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
1	2/3/2023	Date Out		2/13/2023	Date In		2/6/2013	Previous Return				Location	OC Carnival Event
2		SERIAL NUMBERS			Apples											Oranges		Pears
3		011	4016	4264	4476	4716	4945	5106	5318	5537	5727	5943	6407	6548	6721	MB006	9569	MB211	A322
4		016	4017	4275	4480	4717	4948	5107	5320	5540	5731	5945	6408	6553	6722	MB007	9570	MB212	A348
5		017	4018	4279	4482	4718	4949	5109	5328	5542	5732	5947	6409	6554	6724	MB011	9571	MB214	A349
6		023	4019	4285	4483	4720	4954	5111	5131	5543	5734	5948	6410	6556	6725	MB027	9572	MB215	A350
7		027	4022	4292	4492	4723	4955	5115	5333	5545	5738	5950	6415	6558	6728	MB028	9573	MB216	A351
8		029	4024	4294	4495	4728	4956	5117	5334	5546	5741	5953	6416	6561	6729	MB029	9574	MB217	A352
9		030	4029	4295	4496	4731	4957	5121	5343	5549	5742	5954	6417	6563	6730	MB030	9575	MB219	A375
68		4013	4259	4467	4712	4938	5104	5313	5532	5720	5939	6115	6540	6706	6858	MB184	MB002	A285	MB387
69		4015	4263	4469	4714	4941	5105	5317	5533	5724	5940	6116	6544	6709	6860	MB185	MB003	A287	MB388
70		SERIAL NUMBERS			Apples											Oranges		Pears
71		New Return			Prev Return			Damaged Return			####	Not Returned
Receipt

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
G71	Cell Value	duplicates	text	NO
D71	Cell Value	duplicates	text	NO
C3:S4	Cell Value	duplicates	text	NO

The user then clicks the record button on the Receipt form and this color-coded data is transferred to the Record sheet (albeit, very slowly thanks to the copy & pastespecial code I'm currently using--did I mention I'm new at VBA?). With the Record sheet, I use an Advanced Filter in VBA to match data based on the receipt number for reloading any stored receipts and their color-coded data (also, pretty slow).

Book1.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
1	Barcodes																									Criteria:	uID	RA No.	RTN No.		Filter
2	uID	Pfx	RA No.	RTN No.	sr1	sr2	sr3	sr4	sr5	sr6	sr7	sr8	sr9	sr10	sr11	sr12	sr13	sr14	sxb1	sxb2	pws1	pws2	RECrow	Row			1	10000	02		uID	Pfx	RA No.	RTN No.	sr1	sr2	sr3	sr4	sr5	sr6	sr7	sr8	sr9	sr10	sr11	sr12	sr13	sr14	sxb1	sxb2	pws1	pws2	RArow	Row
3	1	RR	10000	02	011	4016	4264	4476	4716	4945	5106	5318	5537	5727	5943	6407	6548	6721	MB006	9569	MB211	A322	3	3							1	RR	10000	02	011	4016	4264	4476	4716	4945	5106	5318	5537	5727	5943	6407	6548	6721	MB006	9569	MB211	A322	3	3
4	1	RR	10000	02	016	4017	4275	4480	4717	4948	5107	5320	5540	5731	5945	6408	6553	6722	MB007	9570	MB212	A348	4	4							1	RR	10000	02	016	4017	4275	4480	4717	4948	5107	5320	5540	5731	5945	6408	6553	6722	MB007	9570	MB212	A348	4	4
5	1	RR	10000	02	017	4018	4279	4482	4718	4949	5109	5328	5542	5732	5947	6409	6554	6724	MB011	9571	MB214	A349	5	5							1	RR	10000	02	017	4018	4279	4482	4718	4949	5109	5328	5542	5732	5947	6409	6554	6724	MB011	9571	MB214	A349	5	5
6	1	RR	10000	02	023	4019	4285	4483	4720	4954	5111	5131	5543	5734	5948	6410	6556	6725	MB027	9572	MB215	A350	6	6							1	RR	10000	02	023	4019	4285	4483	4720	4954	5111	5131	5543	5734	5948	6410	6556	6725	MB027	9572	MB215	A350	6	6
7	1	RR	10000	02	027	4022	4292	4492	4723	4955	5115	5333	5545	5738	5950	6415	6558	6728	MB028	9573	MB216	A351	7	7							1	RR	10000	02	027	4022	4292	4492	4723	4955	5115	5333	5545	5738	5950	6415	6558	6728	MB028	9573	MB216	A351	7	7
8	1	RR	10000	02	029	4024	4294	4495	4728	4956	5117	5334	5546	5741	5953	6416	6561	6729	MB029	9574	MB217	A352	8	8							1	RR	10000	02	029	4024	4294	4495	4728	4956	5117	5334	5546	5741	5953	6416	6561	6729	MB029	9574	MB217	A352	8	8
9	1	RR	10000	02	030	4029	4295	4496	4731	4957	5121	5343	5549	5742	5954	6417	6563	6730	MB030	9575	MB219	A375	9	9							1	RR	10000	02	030	4029	4295	4496	4731	4957	5121	5343	5549	5742	5954	6417	6563	6730	MB030	9575	MB219	A375	9	9
10	1	RR	10000	02	4015	4263	4469	4714	4941	5105	5317	5533	5724	5940	6116	6544	6709	6860	MB185	MB003	A287	MB388	69	10							1	RR	10000	02	4015	4263	4469	4714	4941	5105	5317	5533	5724	5940	6116	6544	6709	6860	MB185	MB003	A287	MB388	69	10
Record

Cell Formulas
Range	Formula
BB3:BB10,X3:X10	X3	=ROW()

Question 1
What methods or coding can be used to improve the data transfer speed? Even as a newbie, I can tell Excel is struggling to process all the formatting. With a range potential of 1200 numbers on the receipt form, I imagine crashes are bound to happen.

Question 2
Depending on the method/code provided, how can I also have every barcode that is checked in on the Receipt form, marked "In" and for every damaged item, marked "DMG" on the Inventory sheet?

I just recently read that working with color & formatting is not advisable with data transfer and I see why however, the visual representation is crucial here. I'm open to any workarounds as long as the color formatting becomes available for the final printed Receipt form.

Inventory sample:

Book1.xlsm
	A	B	C	D	E	F	G	H
1	Item ID	SerialNumber	Item	Description	Status	Location	DateOut	ReturnDate
2	1	011	Apples	Red Delicious	OUT	OC Carnival Event	2/3/2023
3	2	016	Apples	Granny Smith	OUT	OC Carnival Event	2/3/2023
4	3	017	Apples	Granny Smith	OUT	OC Carnival Event	2/3/2023
5	4	023	Apples	Red Delicious	OUT	OC Carnival Event	2/3/2023
6	5	MB006	Oranges	Naval	IN	Warehouse		2/6/2023
7	6	029	Apples	Granny Smith	OUT	OC Carnival Event	2/3/2023
8	7	A322	Pears	Bosch	OUT	OC Carnival Event	2/3/2023
9	8	MB211	Pears	Bosch	IN	Warehouse		2/6/2023
10	9	9569	Oranges	Naval	OUT	OC Carnival Event	2/3/2023
Inventory

 

[offthelip]

See my comments on this thread:
Office Themes and VBA Color Sorting/Filtering Issues
I would suggest the same applies to you.

 

[Lil Stinker]

It was actually another one of your posts that caught my attention (Looping through sheets, Searching for duplicate in column using ".Find"). It's why I'm looking for suggestions to work around the color transferring. I wonder though, is it just color specifically that Excel has trouble with or will any custom formatting, i.e., cell borders or font attributes, cause the same type of issues?

 

[offthelip]

The key to the problem is that VBA is very fast when things are executed in memory but it is really slow in transferring anything from the worksheet to memory or writing anything from memory back to the worksheet. However there two things which you can transfer to and from the worksheet in bulk quickly, the first is values and the second is formula. So you can load a whole huge range of values from the worksheet into memory and it takes only very slightly longer that it takes to load a single cell into memory. This is why if you want to design a fast system when using VBA you must store data as values

All formatting has to be written or tested cell by cell which is always gong to be slow.
Try running these two macros which do exactly the same thing, which is add 1 to every cells in the range A1 to A1000 in a loop of 10. Accessing the cells takes about 6.7 seconds on my computer, while the variant array solution takes 15 milliseconds on my computer.

Sub speedyarray()
Dim StartTime As Double
'initialise
Worksheets("Sheet3").Select
With Worksheets("Sheet3") ' this access the worksheet
 lastrow = 1000 '
 Range(.Cells(1, 1), .Cells(lastrow, 1)) = 0 ' this access the worksheet
End With
StartTime = Timer
With Worksheets("Sheet3") ' this access the worksheet
inarr = Range(.Cells(1, 1), .Cells(lastrow, 1))  ' this access the worksheet
For j = 1 To 10
For i = 1 To lastrow  ' the loop starts here and nothing in the loop access the worksheet
 inarr(i, 1) = inarr(i, 1) + 1
Next i  ' loop ends here
Range(.Cells(1, 1), .Cells(lastrow, 1)) = inarr
Next j
'Range(.Cells(1, 4), .Cells(lastrow2, 6)) = outarr ' this access the worksheet.
End With
SecondsElapsed = (1000 * (Timer - StartTime))
MsgBox SecondsElapsed
 
End Sub
Sub speedycells()
Dim StartTime As Double
'initialise
Worksheets("Sheet3").Select
With Worksheets("Sheet3") ' this access the worksheet
 lastrow = 1000 '
 Range(.Cells(1, 1), .Cells(lastrow, 1)) = 0 ' this access the worksheet
End With
StartTime = Timer
For j = 1 To 10
For i = 1 To lastrow  ' the loop starts here and the next line in the loop accesses the worksheet
 Cells(i, 1) = Cells(i, 1) + 1
Next i  ' loop ends here
Next j
SecondsElapsed = (1000 * (Timer - StartTime))

MsgBox SecondsElapsed
End Sub