VBA Code IF Not ISEMPTY, Copy/Paste

[lamarh755]

I have a spreadsheet where the data gets imported from a productivity database report. Some days the information comes across in alignment and other days the report columns are out of alignment. I already have a macro that aligns the data on days where the report comes across out of alignment. I am now trying to have a macro created to do the following...

* Set the range as ("D3:D") and the last used row in Column C
* For each cell in Column D that is not blank...
1) Copy the value in cell B of that same row and paste the data into cell A of that same row.
2) Copy the value in cell D of that same row and paste the data into cell B of that same row.

* Once that loop is complete, I want to clear the contents in Column D

Example below.

Thank you

 

[Peter_SSs]

I suggest that you investigate XL2BB for providing sample data to make it easier for helpers by not having to manually type out sample data to test with.

Try this with a copy of your data.
I have assumed that there will always be at least 1 non-blank cell in column D (with a corresponding blank cell in column A) & that those apparently blank cells in column A are in fact empty.

Sub lamarh755()
  With Range("A3:A" & Range("C" & Rows.Count).End(xlUp).Row).SpecialCells(xlBlanks)
    .Value = .Offset(, 1).Value
    .Offset(, 1).Value = .Offset(, 3).Value
  End With
  Columns("D").ClearContents
End Sub

 

[lamarh755]

Thank you for providing the information about XL2BB. I will post the samples as advised going forward.

The code that you gave me worked, thank you. There will be times where there is no data at all in Column D. Whenever there is data in Column D, Column A will always be blank.

 

[Peter_SSs]

There will be times where there is no data at all in Column D.

If that happens, then I assume that there would be no blanks in column A and my code would error. This would be safer:

Sub lamarh755_v2()
  Dim rBlanks As Range
  
  On Error Resume Next
  Set rBlanks = Range("A3:A" & Range("C" & Rows.Count).End(xlUp).Row).SpecialCells(xlBlanks)
  On Error GoTo 0
  If Not rBlanks Is Nothing Then
    With rBlanks
      .Value = .Offset(, 1).Value
      .Offset(, 1).Value = .Offset(, 3).Value
    End With
    Columns("D").ClearContents
  End If
End Sub

 

[lamarh755]

That worked. Thank you!

 

[Peter_SSs]

That worked. Thank you!

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

 

[lamarh755]

I thought that the macro worked properly but it is actually not working properly. I downloaded the XL2BB add on and I have included a copy of the actual report I am working on. I originally abbreviated the range, thinking that I could adjust the code to the expanded range once I got the initial macro to work. I have been trying to figure this out on my own to no avail. With the expanded file, I am trying to have the code look for non blanks in Column T. When there are non blanks in Column T, copy the data from Column R and paste it into Column Q. Next, copy the data from Column T and paste it into Column R. The data originally showing in Column Q should remain there because when there is information in Column Q originally, Column T is blank. The last row changes on the report from day to day. Any assistance would be greatly appreciated. Thank you.

Book14
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
1	Work Team	User	Var	Expected	Actual	Direct	Indirect	Direct II	Indirect II	Direct III	Indirect III	Paid Break	Total	Unpaid Break	Count	Units	Units/Hr	Unmeasured%	Indirect%
2	Work Team: A SHIFT
3		D01671	5	9.12	8.69	0.00	0.00	1.89	0.00	0.00	1.00	11.57	0.00	135	115			13	24.98%	18
4		D02041	17	10.86	9.28	0.00	0.00	1.60	0.00	0.00	1.00	11.88	0.00	276	207			22	21.89%	15
5		D02472	-9	9.43	10.35	0.00	0.00	0.44	0.00	0.00	1.00	11.79	0.00	165	158			15	12.21%	4
6		D02724	-16	8.60	10.20	0.00	0.00	0.62	0.00	0.00	1.00	11.83	0.00	159	153			15	13.69%	6
7		F00006	33	8.23	6.18	0.00	0.00	4.72	0.00	0.00	1.00	11.90	0.00	210	172			28	48.07%	43
8		F06329	-50	1.62	3.22	0.00	0.00	7.46	0.00	0.00	1.00	11.69	0.00	69	25			8	72.37%	70
9		F07537	38	2.28	1.66	0.00	0.00	0.29	0.00	0.00	0.00	1.95	0.00	26	22			13	14.87%	15
10		F08980	32	12.35	9.33	0.00	0.00	1.55	0.00	0.00	1.00	11.88	0.00	232	224			24	21.46%	14
11		F10258	-33	4.08	6.04	0.00	0.00	4.95	0.00	0.00	1.00	11.99	0.00	174	57			9	49.62%	45
12		F15490	-87	0.54	4.24	0.00	0.00	6.78	0.00	0.00	1.00	12.02	0.00	41	14			3	64.73%	62
13		F17060	-16	8.66	10.36	0.00	0.00	0.43	0.00	0.00	1.00	11.79	0.00	166	154			15	12.13%	4
14		F18072	19	11.60	9.74	0.00	0.00	1.51	0.00	0.00	0.50	11.75	0.00	239	221			23	17.11%	13
15		F18422	13	13.11	11.59	0.00	0.00	0.30	0.00	0.00	0.00	11.88	0.00	236	227			20	2.53%	3
16		F19466	-3	10.46	10.80	0.00	0.00	1.12	0.00	0.00	0.00	11.91	0.00	179	172			16	9.40%	9
17		F19738	-22	1.58	2.03	0.00	0.00	0.03	0.00	0.00	0.00	2.06	0.00	31	29			14	1.46%	2
18		F20106	-7	9.91	10.67	0.00	0.00	0.24	0.00	0.00	1.00	11.91	0.00	205	196			18	10.41%	2
19		F20899	77	15.35	8.65	0.00	0.00	1.76	0.00	0.00	1.00	11.40	0.00	154	146	Shipping Units	17	17	24.21%
20		F21123	4	11.20	10.76	0.00	0.00	0.17	0.00	0.00	1.00	11.94	0.00	187	179			17	9.80%	2
21		F21124	-2	9.73	9.88	0.00	0.00	0.99	0.00	0.00	1.00	11.87	0.00	164	156	Shipping Units	16	9	16.76%
22		F21408	-26	7.37	9.96	0.00	0.00	0.70	0.00	0.00	1.00	11.66	0.00	152	142			14	14.58%	7
23		F22531	-5	10.28	10.78	0.00	0.00	0.63	0.00	0.00	0.50	11.92	0.00	191	181			17	9.48%	6
24		F23421	21	18.07	14.89	0.00	0.00	0.09	0.00	0.00	0.50	15.48	0.00	419	411			28	3.81%	1
25		F24222	-4	6.64	6.93	0.00	0.00	3.88	0.00	0.00	1.00	11.81	0.00	117	105			15	41.32%	36
26		F24558	-6	2.63	2.79	0.00	0.00	4.16	0.00	0.00	1.00	7.95	0.00	60	47	Shipping Units	17	60	64.91%
27		F24825	-16	8.91	10.57	0.00	0.00	0.34	0.00	0.00	1.00	11.91	0.00	139	133	Shipping Units	13	3	11.25%
28		F24829	-8	9.05	9.82	0.00	0.00	0.23	0.00	0.00	1.00	11.06	0.00	172	165			17	11.12%	2
29		F26944	-24	6.94	9.14	0.00	0.00	1.65	0.00	0.00	1.00	11.79	0.00	119	111	Shipping Units	12	15	22.48%
30		F26946	-24	6.90	9.11	0.00	0.00	1.73	0.00	0.00	1.00	11.84	0.00	108	102	Shipping Units	11	16	23.06%
31	Work Team: B SHIFT
32		F21806	13	12.74	11.26	0.00	0.00	0.26	0.00	0.00	0.00	11.52	0.00	224	216			19	2.26%	2
33		F24237	11	11.67	10.54	0.00	0.00	0.37	0.00	0.00	1.00	11.90	0.00	215	204			19	11.51%	3
34		F25031	-3	8.29	8.58	0.00	0.00	0.49	0.00	0.00	0.50	9.57	0.00	131	119			14	10.34%	5
35		F26941		0.00	0.00	0.00	0.00	5.94	0.00	0.00	0.50	6.44	0.00	4	0			0	100.00%	100
36	Work Team: C SHIFT
37		F10773	-12	5.39	6.14	0.00	0.00	1.27	0.00	0.00	0.50	7.91	0.00	115	100			16	22.38%	17
38		F18076		0.00	0.00	0.00	0.00	0.00	0.00	0.00	0.00	0.00	0.00	20	15			0		0
39		F22522	-8	9.40	10.24	0.00	0.00	0.43	0.00	0.00	1.00	11.67	0.00	183	142			14	12.25%	4
40		F24557	-68	1.41	4.33	0.00	0.00	6.68	0.00	0.00	1.00	12.01	0.00	42	26			6	63.95%	61
41		F25890	8	8.89	8.25	0.00	0.00	0.79	0.00	0.00	1.00	10.04	0.00	171	163			20	17.83%	9
42		F26547	-3	7.12	7.34	0.00	0.00	1.69	0.00	0.00	1.00	10.04	0.00	127	116			16	26.79%	19
43	Work Team: D SHIFT
44		D30031	24	11.81	9.51	0.00	0.00	0.08	0.00	0.00	0.00	9.59	0.00	235	223			23	0.83%	1
45		F00023	-9	8.86	9.78	0.00	0.00	0.44	0.00	0.00	0.00	10.22	0.00	142	133			14	4.31%	4
46		F14722	-17	9.00	10.89	0.00	0.00	0.03	0.00	0.00	1.00	11.92	0.00	134	129			12	8.64%	0
47		F16868	-34	6.37	9.59	0.00	0.00	1.30	0.00	0.00	1.00	11.89	0.00	100	94			10	19.34%	12
48		F22525	-7	9.94	10.71	0.00	0.00	0.20	0.00	0.00	1.00	11.92	0.00	218	199			19	10.07%	2
49		F23363	-15	8.77	10.37	0.00	0.00	0.16	0.00	0.00	1.00	11.53	0.00	176	171			16	10.06%	2
50		F23364	-13	8.97	10.32	0.00	0.00	0.64	0.00	0.00	0.50	11.46	0.00	153	141			14	9.95%	6
51		F23882	-27	7.69	10.56	0.00	0.00	0.28	0.00	0.00	1.00	11.84	0.00	150	144			14	10.81%	3
52		F23886	1	0.52	0.51	0.00	0.00	7.00	0.00	0.00	1.00	8.51	0.00	16	9	Shipping Units	18	93	94.01%
53		F23887	6	11.35	10.68	0.00	0.00	0.77	0.00	0.00	0.50	11.95	0.00	234	220			21	10.63%	7
54		F24236	0	10.96	10.94	0.00	0.00	0.08	0.00	0.00	1.00	12.01	0.00	225	195			18	8.99%	1
55		F24556	-25	8.46	11.24	0.00	0.00	0.22	0.00	0.00	0.50	11.96	0.00	183	178			16	6.02%	2
56		F25034	-2	3.82	3.88	0.00	0.00	1.29	0.00	0.00	0.50	5.68	0.00	82	74			19	31.51%	25
57		F25037	-9	9.81	10.76	0.00	0.00	0.14	0.00	0.00	1.00	11.90	0.00	188	183			17	9.58%	1
58		F25365	-55	0.74	1.67	0.00	0.00	0.82	0.00	0.00	0.00	2.49	0.00	24	14	Shipping Units	8	33	32.93%
59		F25367	-20	8.72	10.85	0.00	0.00	0.05	0.00	0.00	1.00	11.90	0.00	153	143			13	8.82%	0
60		F25370	-25	7.38	9.83	0.00	0.00	1.03	0.00	0.00	1.00	11.87	0.00	143	134			14	17.10%	10
61		F25371	-13	9.24	10.58	0.00	0.00	0.24	0.00	0.00	1.00	11.82	0.00	184	175			17	10.49%	2
62		F25891	-15	8.92	10.49	0.00	0.00	0.10	0.00	0.00	1.00	11.60	0.00	118	113			11	9.48%	1
63		F26940	-68	3.58	11.15	0.00	0.00	0.38	0.00	0.00	1.00	12.53	0.00	100	95	Shipping Units	9	3	11.01%
64		F26942	-64	0.76	2.09	0.00	0.00	2.55	0.00	0.00	0.50	5.15	0.00	14	11	Shipping Units	5	55	59.22%
65		F26951	56	16.80	10.74	0.00	0.00	0.08	0.00	0.00	1.00	11.82	0.00	148	143	Shipping Units	13	1	9.14%
66
67	Grand Total:		-6	472.84	501.49	0.00	0.00	86.07	0.00	0.00	45.50	633.06	0.00	8877	8046		16	15	20.78%
Sheet1

Cell Formulas
Range	Formula
S67,S3:S65	S3	=IFERROR((F3+H3+J3+K3)/L3,"")

 

[Peter_SSs]

OK, try this instead

Sub lamarh755_v3()
  Dim rColQ As Range, rBlanks As Range
  
  Set rColQ = Range("Q3:Q" & Range("T" & Rows.Count).End(xlUp).Row)
  On Error Resume Next
  Set rBlanks = rColQ.SpecialCells(xlBlanks)
  On Error GoTo 0
  If Not rBlanks Is Nothing Then
    With rBlanks
      .FormulaR1C1 = "=if(RC[1]="""","""",RC[1])"
      rColQ.Value = rColQ.Value
      .Offset(, 1).FormulaR1C1 = "=if(RC[2]="""","""",RC[2])"
      rColQ.Offset(, 1).Value = rColQ.Offset(, 1).Value
      .Offset(, 3).ClearContents
    End With
  End If
End Sub

 

[lamarh755]

That did exactly what I needed it to, thank you!!! I really appreciate your assistance.

 

[Peter_SSs]

That did exactly what I needed it to, thank you!!! I really appreciate your assistance.

Good news! You're welcome.