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>

 

[WarPigl3t]

Not enough information provided. Here's what I interpret from what you said and I am guessing on some of this. C1 equals A1 no matter what because it's the first row. C2 equals C1 becuse B2 is less than B1. If B2 was greater than B1, then C2 would equal A2. But here's where it gets confusing. C4 has a date in it with no data in A4 or B4. I don't understand why the date in C4 is equal to the date in A2. What is it suppose to do if the row has a blank A and B column? To solve this problem, please provide a larger dataset with every possible occurance. Possible occurances should be things like if column A in a row is blank, if column B in a row is blank, if column A and B in a row are blank, if a row's value in column B is equal to the same value in the next row in column B. Please provide a dataset of 20 rows or more with all possible occurances.

 

[mfarr76]

Thank for the reply and I will try to give you more detail.

Below will hopefully be more clear.

The worksheet will initially contain only the "Date" and "Number of Occurences" column. My wish is to have code to read the "Number of Occurrences" column and if the value is great than zero, copy and paste the date (Date Column) in another column, say column "L".

Below is an example, the first non-zero "Number of Occurrences" cell tells the code to copy "3/1/13" and paste 3 times in column "L". Below column L is titled "Paste the date based on number of occurrences". After this action has been performed, the code will continue down the number of occurences column continuing the copy/paste action.

Hopefully I was more clear in my needs.

Thank you

Date	Number of Occurrences	blank-column	Paste the date based on number of occurences
3/1/13	3		3/1/13
4/1/13	0		3/1/13
5/1/13	2		3/1/13
6/1/13	4		5/1/13
			5/1/13
			6/1/13
			6/1/13
			6/1/13
			6/1/13

<tbody>
</tbody>

 

[hiker95]

mfarr76,

Sample raw data:

Excel 2007
	A	B	L
1	Date	Number of Occurrences
2	3/1/13	3
3	4/1/13	0
4	5/1/13	2
5	6/1/13	4
6
7
8
9
10
11
Sheet1

After the macro using two arrays in memory:

Excel 2007
	A	B	L
1	Date	Number of Occurrences
2	3/1/13	3	3/1/13
3	4/1/13	0	3/1/13
4	5/1/13	2	3/1/13
5	6/1/13	4	5/1/13
6			5/1/13
7			6/1/13
8			6/1/13
9			6/1/13
10			6/1/13
11
Sheet1

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).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub DuplicateDates()
' hiker95, 10/31/2014, ME815376
Dim a, o
Dim i As Long, j As Long
Dim lr As Long, n As Long, k As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
a = Range("A1:B" & lr)
n = Evaluate("=Sum(B2:B" & lr & ")")
ReDim o(1 To n, 1 To 1)
For i = 2 To lr
  If a(i, 2) > 0 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("L2").Resize(n, 1)
  .Value = o
  .NumberFormat = "m/d/yy"
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 macro.

 

[WarPigl3t]

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
            Loop 
        End If
        i = i + 1
    Loop
End Sub

This code does not format the cells as Date so I suggest you select the entire column L and change the format to date. Then go ahead and change the formatting of your header in cell L1 to Text. If you don't do this, the output will be a bunch of numbers.

 

[mfarr76]

Hiker95,

Thank you for the help. On a new spreadsheet it worked great, exactly what I was looking for. When I applied it to the existing worksheet I was working with I get a Run-time error '13' Type mismatch. I researched it and I think it is a formatting issue, any suggestions?

 

[WarPigl3t]

Oh crap. I just looked at my code again now that you replied and noticed I forgot something which probably caused your excel to crash. I created an infinate loop. Find the line of code that says "iL = iL + 1". Under that line, create a new line of code above where it says "Loop" that says

c = c + 1

 

[mfarr76]

Warpiglet,

Thanks you for your help. When I run the code you provided it runs an entire column of the first date and freezes the spreadsheet. Am I doing something wrong?

 

[hiker95]

mfarr76,

On a new spreadsheet it worked great, exactly what I was looking for. When I applied it to the existing worksheet I was working with I get a Run-time error '13' Type mismatch. I researched it and I think it is a formatting issue, any suggestions?

It is always best to display your actual raw data worksheet(s), and, the results that you are looking for. This way we can usually find a solution on the first go.

My macro worked on your posted screenshots.

So that I can get it right this next time, and, in order to continue, I will have to see your actual workbook/worksheet.

You can upload your workbook to Box Net,

sensitive data changed

mark the workbook for sharing

and provide us with a link to your workbook.

 

[mfarr76]

I tried your fix but it still is running in an infinite loop, any other suggestions?