Previous Topic Next Topic

Populate cells based on criteria...

Closed
fireburn Posts 28 Registration date Monday February 3, 2014 Status Member Last seen June 23, 2014 - Mar 5, 2014 at 07:50 PM
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 - Apr 28, 2014 at 11:25 AM
Hello,

A B C D E F
01012014(Date) 1234 1234 01012014 (Start Date) 01012014 (EndDate) 2



Result

A B C D E F
01012014 1234 1234 01012014 02012014 2
01012014 1234 1234
02012014 1234 1234
02012014 1234 1234


Need help for a code! I want to populate (insert) the column based on criteria wherein, i will input a start date on D1, and End date on E1 and how many times in a day on F2.


2 responses

Answer 1 / 2
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
Mar 10, 2014 at 12:10 PM
Hi Fireburn,

This seems very similar to your previous question. Are you still having trouble with this?

Best regards,
Trowa
0
fireburn Posts 28 Registration date Monday February 3, 2014 Status Member Last seen June 23, 2014
Mar 19, 2014 at 11:36 AM
Hi,

I am not having trouble with the one that you gave me on my other post. I just want to make it easier. I really don't have a knowledge in VB. My objective is repeating a row with only the first column is changing, that is the date of visit. So when when we visited the client 2X in a day, we suppose to have 2 rows for that. So let's say 2X/ day in 7 days, tha's a 14 rows with only the dates have changed. So if we can just input the start date in a cell and end date and how many times in a day. It will copy the entire range (row) A:M automatically. Sorry for asking too much. This will be entirely use in Seniors home, and not in any commercial or profitable sort. Thank you.
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
Mar 24, 2014 at 01:02 PM
Hi Fireburn,

I am working on a solution, but couldn't finish today.

Just wanted you to know I didn't forgot about you.

Best regards,
Trowa
0
Answer 2 / 2
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
Mar 25, 2014 at 11:52 AM
Hi Fireburn,

To make things easier for you, you don't have to run the code manually. Instead after entering the number of visits, the code will run automatically. So make sure that the number of visits is the last thing you enter in your range (A:M).

To make this work, right-click on the sheets tab and select view code. Paste the following code in the big white field of the newly opened window: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x, y, nRow, sMid1, sMid2, dayDiff As Integer
Dim sDate, eDate As Date
Dim nDate As Long

If Intersect(Target, Columns("F:F")) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
If Target.Value = vbNullString Then Exit Sub
If IsNumeric(Target.Value) = False Then Exit Sub
If Target.Value = 0 Then Exit Sub

'Do nothing when Start date = End date AND visits = 1

'Do the following when Start dat = End Date AND visits > 1
If Target.Offset(0, -2).Value = Target.Offset(0, -1).Value And Target.Value > 1 Then
    x = Target.Value
    nRow = 0
    Do
        nRow = nRow + 1
        Range(Cells(Target.Row, "A"), Cells(Target.Row, "M")).Copy
        Target.Offset(nRow, -5).PasteSpecial
        x = x - 1
    Loop Until x = 1
End If

'Determine Start date, End date and Daydiff
If Len(Target.Offset(0, -2).Value) = 8 Then sMid1 = 3 Else sMid1 = 2
If Len(Target.Offset(0, -1).Value) = 8 Then sMid2 = 3 Else sMid2 = 2

sDate = DateValue(Left(Target.Offset(0, -2).Value, Len(Target.Offset(0, -2).Value) - 6) & "-" & _
        Mid(Target.Offset(0, -2).Value, sMid1, 2) & "-" & _
        Right(Target.Offset(0, -2).Value, 4))
eDate = DateValue(Left(Target.Offset(0, -1).Value, Len(Target.Offset(0, -1).Value) - 6) & "-" & _
        Mid(Target.Offset(0, -1).Value, sMid2, 2) & "-" & _
        Right(Target.Offset(0, -1).Value, 4))

dayDiff = eDate - sDate

'Do the following when Start date <> End Date AND visits = 1
If Target.Value = 1 Then
    nRow = 0
    Do
        nRow = nRow + 1
        Range(Cells(Target.Row, "A"), Cells(Target.Row, "M")).Copy
        Target.Offset(nRow, -5).PasteSpecial
        sDate = sDate + 1
        If Month(sDate) < 10 Then
            nDate = Day(sDate) & "0" & Month(sDate) & Year(sDate)
        Else
            nDate = Day(sDate) & Month(sDate) & Year(sDate)
        End If
        Target.Offset(nRow, -5).Value = nDate
        dayDiff = dayDiff - 1
    Loop Until dayDiff = 0
End If

'Do the following when Start date <> End date AND visits > 1
x = Target.Value
nRow = 0

Do
    nRow = nRow + 1
    Range(Cells(Target.Row, "A"), Cells(Target.Row, "M")).Copy
    Target.Offset(nRow, -5).PasteSpecial
    x = x - 1
Loop Until x = 1

x = Target.Value
y = x

Do
    dayDiff = dayDiff - 1
    Range(Cells(Target.Row, "A"), Cells(Target.Row + x - 1, "M")).Copy
    Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
    
    sDate = sDate + 1
    If Month(sDate) < 10 Then
        nDate = Day(sDate) & "0" & Month(sDate) & Year(sDate)
    Else
        nDate = Day(sDate) & Month(sDate) & Year(sDate)
    End If
    
    For Each cell In Range(Cells(Target.Row + y, "A"), Cells(Target.Row + y + x - 1, "A"))
        cell.Value = nDate
    Next cell
    y = y + x
Loop Until dayDiff = 0

Application.CutCopyMode = False

End Sub

Best regards,
Trowa
0
fireburn Posts 28 Registration date Monday February 3, 2014 Status Member Last seen June 23, 2014
Mar 25, 2014 at 03:04 PM
Hi,

I really appreciate your effort in helping me out. When i run the code it gives me error. "Run-time error "13" Type Mismatch
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
Mar 27, 2014 at 11:38 AM
Hi Fireburn,

It's always hard to tell what produces an error without the actual data.

You can start by telling me which code line turns yellow.

But I will probably need to look at your file to find the issue.

Prepare your file for public viewing (removing/changing personal info), upload to a filesharing site like www.speedyshare.com or ge.tt etc... and post back the download link.

Best regards,
Trowa
0
fireburn Posts 28 Registration date Monday February 3, 2014 Status Member Last seen June 23, 2014
Apr 10, 2014 at 12:43 PM
Hi,

I uploaded a sample file for this purpose.

http://speedy.sh/K679W/Samplefile.xlsx

Thank you so much. Have a nice day.

Fireburn
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
Apr 14, 2014 at 10:40 AM
Hi Fireburn,

This doesn't look like your sample data! No wonder the code doesn't work.

Where is your end date? Where is the number for visits amount?

What I am thinking now is that you manually select which row to handle.
You run the code and Excel will ask you how many days and how many visits need to be applied to that row. Result will be placed directly below the selected row.

More specifically:
Looking at you sample file, you will click on any cell in row 2. Run the code. Number of days are 7 and number of visits are 2. As a result range A2:A15 is now filled with data.
Now you will enter the next row of data in A16, select any cell in row 16, run the code, days are 7, visits are 1. Now range A16:A22 is filled with data.

Is this something like how you foresee it or do you have other ideas?

Best regards,
Trowa
0
fireburn Posts 28 Registration date Monday February 3, 2014 Status Member Last seen June 23, 2014
Apr 15, 2014 at 02:56 PM
I am sorry for the confusion. Yes, I like your idea. It wil help me a lot. Will it be done with an input box or something when you run the code? Any help to figure out how it will be done easily, im good.. Thank you once again.
0

Similar discussions

help me to add particular cells
mathewmunna -
mathew munna -

2 responses
Excel - IF function with multiple words
Nick -
user -

14 responses
Code for macro that conditionally inserts rows
bfleming -
bfleming -

4 responses
How do I change a base location on Instagram?
rebelkids -
38nancy -

8 responses
If cell contains multiple text how to add other cell value?
Iza -
TrowaD -

1 response