VBA Using subroutines - help please

Solved/Closed
BrianGreen Posts 1005 Registration date Saturday January 17, 2015 Status Moderator Last seen September 30, 2021 - Feb 5, 2016 at 02:59 PM
BrianGreen Posts 1005 Registration date Saturday January 17, 2015 Status Moderator Last seen September 30, 2021 - Feb 10, 2016 at 12:57 AM
Ok guys, I have a problem (well more than one, but Im not sure I should mention those on this forum!).

Im in the process of writing an Excel macro that is supposed to tell me when events are coming up. I have several worksheets with events on - first sheet is social events, sheet 2 is hospital appointments, sheet 3 is when I have to pay bills, and so on.

I want it to show 3 columns - one when an event on any sheet is "booked", one when it is about a week away, and one when the event is gone.

So far I have this code (which works for the first 2 sheets in this example):

Sub ImportantStuff()

MyDay = DateAdd("yyyy", -1, Date)
Nearly = MyDay + 7

Set Rng = ActiveSheet.Range("D6:D10,G6:G10")

For Each x In Rng.Cells

If x < MyDay Then
Cells(15, 5) = x

ElseIf x < Nearly Then
Cells(15, 4) = x

Else: Cells(15, 3) = x

End If
Next

Set Rng = Sheet2.Range("D6:D10,G6:G10")

For Each x In Rng.Cells

If x < MyDay Then
Cells(15, 5) = x

ElseIf x < Nearly Then
Cells(15, 4) = x

Else: Cells(15, 3) = x

End If
Next

End Sub


Now you will notice that a lot of the code is the same for the 2 ranges I have defined. Please could anyone tell me how to put this into a sub so it goes something like this:


Sub ImportantStuff()

MyDay = DateAdd("yyyy", -1, Date)
Nearly = MyDay + 7

Set Rng = ActiveSheet.Range("D6:D10,G6:G10")

Call CheckDates

Set Rng = Sheet2.Range("D6:D10,G6:G10")

Call CheckDates

End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub CheckDates()

For Each x In Rng.Cells

If x < MyDay Then
Cells(15, 5) = x

ElseIf x < Nearly Then
Cells(15, 4) = x

Else: Cells(15, 3) = x

End If
Next

End Sub


Dont worry about the fact I wont see the dates yet - They will get overwritten too fast and I will only see the last date. I can sort that bit later.

As always, there is a virtual beer in it for you, and my undying gratitude.

I really appreciate thank you messages as a payment for solving issues   :o)
Related:

2 responses

BrianGreen Posts 1005 Registration date Saturday January 17, 2015 Status Moderator Last seen September 30, 2021 149
Feb 6, 2016 at 10:35 AM
RayH

You are a star. It works just as I needed it to (until I mess it up with the next bit I have to do). The only thing I needed to do was add a "Global Nearly As Date" as the second line.

It is clear I need to find out about SUBs and the thing you added at the top "Global variable? as a thing" - where do you suggest I can find out about these in an easy to learn source? most of what I have learned is from examples on the net or this forum (thanks guys).

How many virtual beers do you think you can cope with? - here's one to get you started ...


I really appreciate thank you messages as a payment for solving issues   :o)
4
BrianGreen Posts 1005 Registration date Saturday January 17, 2015 Status Moderator Last seen September 30, 2021 149
Feb 6, 2016 at 12:23 PM
I have another question for you Ray if you dont mind ...

t would be nice to know what is happening on the date that has been copied (especially the hospital appointments and the bills). How do I get the data from the cell next to the date in the range and put it in the cell to the left of the date just listed? I have tried an offset, but not sure Im using it correctly, but even more unsure that I can get the cell address that has the date in.

I have made room for this new data, so what I have now is this (I have commented the bit where I think I would get the extra required data from)

Global MyDay As Date
Global Nearly As Date

Sub ImportantStuff()
Dim Rng As Range

MyDay = DateAdd("yyyy", -1, Date)
Nearly = MyDay + 7

Set Rng = ActiveSheet.Range("D6:D10,G6:G10")

Call CheckDates(Rng)

Set Rng = Sheet2.Range("D6:D10,G6:G10")

Call CheckDates(Rng)

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub CheckDates(myrange As Range)

' Find the last row of data
finalrowOverdue = Cells(Rows.Count, 9).End(xlUp).Row
finalrowComingUp = Cells(Rows.Count, 6).End(xlUp).Row
finalrowBooked = Cells(Rows.Count, 3).End(xlUp).Row

For Each x In myrange.Cells

If x < MyDay Then
Cells(finalrowOverdue + 1, 9) = x
'''' Find item in the cell that is to left of the blank space just found.

finalrowOverdue = finalrowOverdue + 1

ElseIf x < Nearly Then
Cells(finalrowComingUp + 1, 6) = x
'''' Find item in the cell that is to left of the blank space just found.

finalrowSoonComingUp = finalrowComingUp + 1

Else: Cells(finalrowBooked + 1, 3) = x
'''' Find item in the cell that is to left of the blank space just found.

finalrowBooked = finalrowBooked + 1

End If


Cocktails for you if you do this - perhaps on a sunny beach.
0
RayH Posts 122 Registration date Tuesday August 31, 2010 Status Contributor Last seen June 20, 2016 26 > BrianGreen Posts 1005 Registration date Saturday January 17, 2015 Status Moderator Last seen September 30, 2021
Feb 7, 2016 at 10:46 PM
Glad to help and thanks for the Beer!
Can you post a sample of what you have in the sheets I would help a great deal.
Testing with imaginary data isn't that easy.
0
BrianGreen Posts 1005 Registration date Saturday January 17, 2015 Status Moderator Last seen September 30, 2021 149 > RayH Posts 122 Registration date Tuesday August 31, 2010 Status Contributor Last seen June 20, 2016
Feb 8, 2016 at 01:31 PM
Hi Ray,

Unfortunately I cant do post the sheets until Wednesday morning, but if you are happy for me to describe it here, then here goes ...

Cells D6 to D10 and Cells G6 to G10 (and every third column after) on every sheet have the date of an appointment.
Cells C6 to C10 and Cells F6 to F10 (and every third column after) on every sheet have the description of the appointment.

Graphically it looks like this:

................ D .............| .......E ........| ...........F.........| ..........G........| ........H.......|

Go to Fred's house | 01/24/216 | [Empty Cell] | My Birthday | 15/03/2016 |
Buy Tim a pint or 2 | 07/3/2016 | [Empty Cell] | RayH Medal | 09/02/2016 |
.....

So far we (you) have managed to pull the date for me, but it would be nice to see what is associated with the date so I would need the output to be:

RayH Medal | 09/02/2016 |

rather than just

| 09/02/2016 |


I hope thats enough.
0
RayH Posts 122 Registration date Tuesday August 31, 2010 Status Contributor Last seen June 20, 2016 26
Feb 8, 2016 at 02:34 PM
The sample data doesn't seem to reflect the ranges chosen and the locations of the data pulled look like it overwrites the data in the activesheet, but...

You can add this line to pull the description of the appointment:
e.g.
Cells(finalrowOverdue + 1, 8) = x.Offset(0, -1).Value

It takes the cell appointment description from the left of the date.

The others are:
Cells(finalrowComingUp + 1, 5) = x.Offset(0, -1).Value
and
Cells(finalrowCBooked + 1, 2) = x.Offset(0, -1).Value

see how you get on with that.
0
BrianGreen Posts 1005 Registration date Saturday January 17, 2015 Status Moderator Last seen September 30, 2021 149
Feb 10, 2016 at 12:57 AM
Thank you - thank you - thank you.
That must have been the only combination of Offset that I didnt try! (well almost!)

The only thing about offering you a cocktail on the beach is that I have to go as well (or else I cant get you one.. Thats not bad in itself, but I'll have to bring the wife. Im not sure you'd like that!


Heres the cocktails anyway ...
0
Does this work?
Global MyDay As Date

Sub ImportantStuff()
Dim Rng As Range

MyDay = DateAdd("yyyy", -1, Date)
Nearly = MyDay + 7

Set Rng = ActiveSheet.Range("D6:D10,G6:G10")

Call CheckDates(Rng)

Set Rng = Sheet2.Range("D6:D10,G6:G10")

Call CheckDates(Rng)

End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub CheckDates(myrange As Range)

For Each x In myrange.Cells

    If x < MyDay Then
        Cells(15, 5) = x
    
    ElseIf x < Nearly Then
        Cells(15, 4) = x
    
    Else: Cells(15, 3) = x
    
    End If
Next

End Sub
3