Report

VBA Using subroutines - help please [Solved]

Ask a question BrianGreen 877Posts Saturday January 17, 2015Registration date ModeratorStatus August 31, 2016 Last seen - Latest answer on Feb 10, 2016 12:57AM
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.
See more 
Helpful
+4
moins plus
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 ...


BrianGreen 877Posts Saturday January 17, 2015Registration date ModeratorStatus August 31, 2016 Last seen - Feb 6, 2016 12:23PM
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.
Reply
RayH 122Posts Tuesday August 31, 2010Registration date ContributorStatus June 20, 2016 Last seen - Feb 7, 2016 10:46PM
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.
Reply
BrianGreen 877Posts Saturday January 17, 2015Registration date ModeratorStatus August 31, 2016 Last seen - Feb 8, 2016 01:31PM
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.
Reply
RayH 122Posts Tuesday August 31, 2010Registration date ContributorStatus June 20, 2016 Last seen - Feb 8, 2016 02:34PM
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.
Reply
BrianGreen 877Posts Saturday January 17, 2015Registration date ModeratorStatus August 31, 2016 Last seen - Feb 10, 2016 12:57AM
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 ...
Reply
Add comment
Helpful
+3
moins plus
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
Add comment

Members get more answers than anonymous users.

Being a member gives you detailed monitoring of your requests.

Being a member gives you additional options.

Not a member yet?

sign-up, it takes less than a minute and it's free!