Copy and paste based on criteria

[mfarr76]

Hello,

In column A (shown below) I have a list of dates and in column B I have a number which can range from 0 - 9. Based upon the number in B1, I want to use vba to copy cell A1 and paste in C1 (and C2 if B1 has something larger than a 1). I would like to do this for a hundred dates.

The table below shows an example.

Column A contains the dates and column B has a number from 0 - 9. Column C, I want to paste the number of dates based upon the value in column B.

Any help would be greatly appreciated. I am having to do this manually and it can be very time consuming when you have a hundred of these dates to do.

	A	B	C
1	2/1/2015	3	2/1/2015
2	4/1/2015	1	2/1/2015
3	6/1/2015	0	2/1/2015
4			4/1/2015

<tbody>
</tbody>

 

[mfarr76]

Hiker95,

Thank you for the tips...

Below is a link to the file the I am working with. I changed where the code begins to read the values, you had "i = 2 + 1r" and I changed it "i= 16 + 1r". I also changed where it will paste the dates.

https://app.box.com/s/rzlt9purc0t03s9xcec1

Thanks again

 

[WarPigl3t]

The fix I gave you should have prevented the infinate loop, so I'm going to assume you didn't put the fix in the right location. Here is the code with the fix.

Sub myMacro()
    lastRowA = Range("A" & Rows.Count).End(xlup).Row
    lastRowL = Range("L" & Rows.Count).End(xlup).Row
    If lastRowL > 1 Then  'If L1 is the only row in column L with data, it won't clear contents.
         Range("L2:L" & lastRowL).ClearContents
     End If
    i = 2
    iL = 2
    Do Until i > lastRowA
        pasteQuantity = Range("B" & i).Value
        If pasteQuantity > 0 Then
            pasteValue = Range("A" & i).Value
            c = 1
            Do Until c > pasteQuantity
                Range("L" & iL).Value = pasteValue
                iL = iL + 1
                c = c + 1
            Loop
         End If
        i = i + 1
    Loop
End Sub

 

[mfarr76]

I actually had it in the same place but I figured out the infinite loop was being created on the back end. Shown below is an example.

I have several dates that do not have values in B, is there a way to end the loop after say 5 cells are less than 1? Or if there is a better way to do it?

Excel 2010
	A	B
100	1/1/2023	2
101	2/1/2023	2
102	3/1/2023	2
103	4/1/2023	2
104	5/1/2023	2
105	6/1/2023
106	7/1/2023
107	8/1/2023
108	9/1/2023
109	10/1/2023
110	11/1/2023
MAIN
Worksheet Formulas
Cell	Formula
A100	44927

<colgroup><col span="3"></colgroup><tbody>
</tbody>

 

[hiker95]

mfarr76,

Thanks for the workbook.

I assume that we are working in worksheet MAIN?

New sample raw data:

Excel 2007
	A	B	C	D	E
1	DPW WoH Replicator Spreadsheet
2
3
4
5	Number of Rigs	3
6	Spud to RR (INTIAL)	16
7	Spud to RR (FINAL)	15
8	Switch Month	12
9	RR to Sales	15
10	Start Date	1/1/2016		5/6/2016
11	Months BTW Rig start	6
12	Wells Per Month	1.90
13	Total Wells	0
14				Monthly	Aries
15	Month	Well/Month		Schedule	Month
16	1/1/2016				01/1900
17	2/1/2016	1			01/1900
18	3/1/2016	1			01/1900
19	4/1/2016	2			01/1900
20	5/1/2016	2			01/1900
21	6/1/2016	2			01/1900
22	7/1/2016	2			01/1900
23	8/1/2016	3			01/1900
24	9/1/2016	3			01/1900
25	10/1/2016	4			01/1900
26	11/1/2016	4			01/1900
27	12/1/2016	4			01/1900
28	1/1/2017	4			01/1900
29	2/1/2017	5			01/1900
30	3/1/2017	5			01/1900
31	4/1/2017	6			01/1900
32	5/1/2017	6			01/1900
33	6/1/2017	6			01/1900
34	7/1/2017	6			01/1900
MAIN

After the new macro (not all rows are shown for brevity):

Excel 2007
	A	B	C	D	E
1	DPW WoH Replicator Spreadsheet
2
3
4
5	Number of Rigs	3
6	Spud to RR (INTIAL)	16
7	Spud to RR (FINAL)	15
8	Switch Month	12
9	RR to Sales	15
10	Start Date	1/1/2016		5/6/2016
11	Months BTW Rig start	6
12	Wells Per Month	1.90
13	Total Wells	456
14				Monthly	Aries
15	Month	Well/Month		Schedule	Month
16	1/1/2016			2/1/16	02/2016
17	2/1/2016	1		3/1/16	03/2016
18	3/1/2016	1		4/1/16	04/2016
19	4/1/2016	2		4/1/16	04/2016
20	5/1/2016	2		5/1/16	05/2016
21	6/1/2016	2		5/1/16	05/2016
22	7/1/2016	2		6/1/16	06/2016
23	8/1/2016	3		6/1/16	06/2016
24	9/1/2016	3		7/1/16	07/2016
25	10/1/2016	4		7/1/16	07/2016
26	11/1/2016	4		8/1/16	08/2016
27	12/1/2016	4		8/1/16	08/2016
28	1/1/2017	4		8/1/16	08/2016
29	2/1/2017	5		9/1/16	09/2016
30	3/1/2017	5		9/1/16	09/2016
31	4/1/2017	6		9/1/16	09/2016
32	5/1/2017	6		10/1/16	10/2016
33	6/1/2017	6		10/1/16	10/2016
34	7/1/2017	6		10/1/16	10/2016
MAIN

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Sub DuplicateDates_V2()
' hiker95, 11/01/2014, ME815376
Dim a, o
Dim i As Long, j As Long
Dim lr As Long, n As Long, k As Long
With Sheets("MAIN")
  .Activate
  lr = .Cells(Rows.Count, 1).End(xlUp).Row - 1
  a = .Range("A1:B" & lr).Value
  n = Evaluate("=Sum(B16:B" & lr & ")")
  ReDim o(1 To n, 1 To 1)
  For i = 16 To lr
    If a(i, 2) <> "" Then
      For k = 1 To a(i, 2)
        j = j + 1
        o(j, 1) = a(i, 1)
      Next k
    End If
  Next i
  With .Range("D16").Resize(n, 1)
    .Value = o
    .NumberFormat = "m/d/yy"
  End With
End With
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the DuplicateDates_V2 macro.

 

[mfarr76]

Hiker95,

It worked great!! Thank you for the effort and being patient with me. As someone new to this I appreciate it.

Have a great day!!

 

[WarPigl3t]

I see you have a solution so I won't continue my efforts to try to get my solution to work. I am not sure why it is stuck in an infinate loop. You stated that you think the problem was in the second loop and that you think it is due to that you have blank cells after 5 rows. I don't think that is the problem. That was the purpose of my if statement. The if statement checks if the value of the row in the B column is greater than 0. Since a blank is not greater than 0, it would not enter that loop. If I was wrong in that assumption, then you could have easily modified the if statement to say if the row in the B column is greater than 0 and is not blank then continue onto the Do Loop.

If pasteQuantity > 0 AND pasteQuantity <> "" Then

 

[hiker95]

mfarr76,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.

 

[mfarr76]

Warpiglet,

Thank you for the effort and your code works perfectly. Much appreciated