PDA

View Full Version : need help with simple macros



moose123
06-09-2012, 10:37 PM
Hi guys!

I'm new in vba and need help
Please help me with such simple macros

I attached the file with table

I need to compare cells like D2-C2, D3-C2 D3-C2, D4-C2 D4-C3 D4-C4, and so on

and compare it with year

the code which guys from another forum wrote to me is next


Sub myMacro()
Dim li As Long, lr As Long, lLastRow As Long
lLastRow = Cells(Rows.Count, 4).End(xlUp).Row
For li = 1 To lLastRow
For lr = 1 To lLastRow
If YearDiff(Cells(li, 4), Cells(lr, 3)) >= 365 Then Cells(li, 5) = 0
Next lr
Next li
End Sub
Function YearDiff(ByVal Date1 As Date, ByVal Date2 As Date) As Integer
YearDiff = Year(Date2) - Year(Date1) + IIf(Month(Date2) + IIf(Day(Date2) < Day(Date1), -1, 0) < Month(Date1), -1, 0)
End Function

but it's doesn't work for me, maybe I'do something wrong

Teeroy
06-10-2012, 12:34 AM
Welcome to the forum.

I'm not sure I understand exactly what you're trying to achieve but the way you're calling the function you are calculating C2-D3, C2-D4..., C3-D3, C3-D4...etc. (not D-C) and not doing anything with column 5 unless the diff is >=365 where you write 0. Since you are calculating the reverse of what you indicated you were looking for it's much less than 365 (you're getting negative numbers such as -111). Also you're starting your loops from 1 which doesn't include data so you could begin the loops from 2.

If you expand upon you're requirements I'll have a look at it again.

Be careful using merged cells in a spreadsheet where you're writing VBA code; the results can be unexpected.

moose123
06-10-2012, 01:07 AM
Thank you Teeroy!

I attached the file, but don't see it.

as I wrote earlier
I need to compare cells like D2-C2, D3-C2 D3-C2, D4-C2 D4-C3 D4-C4, and so on. If the diff is bigger then a year then write 0 to another cell
Yes my data begins from second row

I tried to attach an image, but I don't have rights to do it )

Aussiebear
06-10-2012, 03:25 AM
I attached the file, but don't see it.

Try using Go Advanced, scroll down to Manage Attachments and follow the prompts from there to attach your file

moose123
06-10-2012, 03:37 AM
Try using Go Advanced, scroll down to Manage Attachments and follow the prompts from there to attach your file
Thanks now I see attached file , do you?

Somebody please help me with macros!

CodeNinja
06-10-2012, 04:54 AM
Moose,
I am really not 100% sure what you want, but it looks like your function returns years different and you are saying well, if it is >= 365, then put a 0 here... and if it is 1 year different, it says, well 1 is not >= 365 so it does nothing... if you had something greater than 365 years different, it would likely put a 0 there.... but that is not really your biggest problem...

If you are looking for 365 days different, you should use the following function
Function DaysDiff(ByVal Date1 As Date, ByVal Date2 As Date) As Integer

Dim ldate1 As Long
Dim ldate2 As Long

ldate1 = CLng(Date1)
ldate2 = CLng(Date2)
DaysDiff = ldate1 - ldate2
If DaysDiff < 0 Then
DaysDiff = DaysDiff * -1
End If
End Function
Now, we have to solve the problem of exactly what you want it to look like... The way you have this, you are looping through column 3 and comparing it to all of column 4, so if cell 2,3 vs 2,4 is greater than (365 days/years whatever), it will put in cell 2,5 a 0. Now, that is fine, but when it loops around again, it will compare cell 3,3 to 2,4 and see that maybe they are not different, so it will do nothing... at the end it is likely you will end up with all 0's in column 5 if you have a lot of dates...

I am not sure I made myself clear, but you need to figure out what you want it to look like at the end.

Good luck, and if you need more help, please be as clear as possible as to what you want the result to be.

moose123
06-10-2012, 08:28 AM
Thank you CodeNinja!

don't look at code, it was written not me. The main task is how to make a loop. which will compare Dates
the loop must compare cells like D2-C2, D3-C2 D3-C3, D4-C2 D4-C3 D4-C4, D5-C2 D5-C3 D5-C4 D5-C5 and so on and if the diff is bigger then a year (365 days)

I wrote such code but it's doesn't loop

Sub myMacro()
Dim i As Integer
Dim k As Integer
i = 1
k = 1
Do While Cells(i, 4) <> ""
Do While Cells(k, 3) <> ""
If Cells(i, 4) - Cells(k, 3) >= 365 Then Cells(k, 5) = 0
k = k + 1
Loop
i = i + 1
Loop

End Sub

All I need for now is to make a loop and after that I will think about what to do next.

Now I think you can understand what I'm trying to do

Paul_Hossler
06-10-2012, 12:25 PM
I still don't understand what you're trying to do for sure



I need to compare cells like D2-C2, D3-C2 D3-C2, D4-C2 D4-C3 D4-C4, and so on and compare it with year


I'm guessing that if the date in D2 is more that a year (365 days) after the date in C2, then you want to put a 0 in E2????

If so, that seems like a very roundabout way to do it

This seems simpler


Option Explicit
Sub myMacro()
Dim li As Long, lLastRow As Long

lLastRow = Cells(Rows.Count, 4).End(xlUp).Row

For li = 2 To lLastRow
If CLng(Cells(li, 4)) - CLng(Cells(li, 3)) > 365 Then
Cells(li, 5) = 0
Else
Cells(li, 5).ClearContents
End If
Next li
End Sub


Paul

moose123
06-10-2012, 01:04 PM
Sorry for my bad explanation

I think you need to see whats in my table to understand what I want to receive
On the first page I attached file with table
And here there is screenshot

http://img13.imageshost.ru/img/2012/06/08/image_4fd1e6d146fa0.gif

As you can see
D2-C2 < 365
D3-C2 < 365
D3-C3 < 365
D4-C2 > 365 E2=0
D4-C3 < 365
D4-C4 < 365
D5-C2 > 365 E2=0
D5-C3 > 365 E3=0
D5-C4 < 365
D6-C2 > 365 E2=0
D6-C3 > 365 E3=0
D6-C4 < 365
D6-C5 < 365
D6-C6 < 365
D7-C2 > 365 E2=0
D6-C3 > 365 E3=0
D6-C4 < 365
D6-C5 < 365
D6-C6 < 365
D6-C7 < 365

So I will have E2=0 and E3=0

That's what I want to receive

Teeroy
06-10-2012, 03:59 PM
The loop you are running through column C is not adding any value to the code. You could achieve the same thing by calculating the difference between each value in column D against the MIN of column C. So varying Paul_Hossler's code (which is easiest to follow) you get the following.

Sub myMacro2()
Dim li As Long, lLastRow As Long
Dim minDate As Date

lLastRow = Cells(Rows.Count, 4).End(xlUp).Row
minDate = Application.Min(Cells(2, 3), Cells(lLastRow, 3))

For li = 2 To lLastRow
If CLng(Cells(li, 4)) - CLng(minDate) > 365 Then
Cells(li, 5) = 0
End If
Next li
End Sub

I removed the "clearcontents" portion of the original loop since you haven't said that that's what you want.

Paul_Hossler
06-10-2012, 04:42 PM
1. In the screen shot, E2 and E3 as not =0

2. I added the .ClearContents since if the data changed and you re-ran the macro, a leftover 0 in E2 or E3 would be wrong

Paul

moose123
06-10-2012, 09:56 PM
Thanks Teeroy, but it's does not work :(

Here is a screen shot
if If CLng(Cells(li, 4)) - CLng(minDate) > 365 Then

http://img13.imageshost.ru/img/2012/06/11/image_4fd57bcce71cd.gif

and if If CLng(Cells(li, 4)) - CLng(minDate) < 365 Then

http://img13.imageshost.ru/img/2012/06/11/image_4fd57b59f2190.gif

To Paul:


1. In the screen shot, E2 and E3 as not =0
Yes on screen shot just data which I have

Teeroy
06-11-2012, 12:28 AM
Sorry Moose123, I misinterpreted where you wanted the "0" displayed. I had it against the D column value where an exceedance was encountered when you wanted it against the C column value. A minor change to the code and it now loops through the C column and compares against the MAX of the D column.
Sub myMacro2()
Dim li As Long, lLastRow As Long
Dim maxDate As Date

lLastRow = Cells(Rows.Count, 4).End(xlUp).Row
maxDate = Application.Max(Cells(2, 4), Cells(lLastRow, 4))

For li = 2 To lLastRow
If CLng(maxDate) - CLng(Cells(li, 3)) > 365 Then
Cells(li, 5) = 0
End If
Next li
End Sub

CodeNinja
06-11-2012, 05:10 AM
Moose,
You were very close with your last post:

Sub myMacro()
Dim i As Integer
Dim k As Integer
i = 1
k = 1
Do While Cells(i, 4) <> ""

DoWhile Cells(k, 3) <> ""


If Cells(i, 4) - Cells(k, 3) >= 365 Then Cells(k, 5) = 0

k = k + 1

Loop

i = i + 1
Loop
End Sub


You need to change 2 things...

First, You set i and k = 1, and when it runs the loop, since cell 1,4 is empty, it considers that loop done... if you set i and k = 2, it will loop...

Second, when subtracting the two values, you need to at the minimum convert them to longs, but better use the function I put at the top of this thread (Teeroy is correct, remove the clear contents because you obviously do not want that). I would not use the minimum date, as you are not directly comparing the two items you want to compare... so if dates in the second column could be before dates in the first, this may not work correctly...
so, second part you need to do is call the function in the loop IE change
If Cells(i, 4) - Cells(k, 3) >= 365 Then Cells(k, 5) = 0
to
If daysdiff(cells(i,4), cells(k,4))>=365 then

Good luck, and let us know how it goes...

CodeNinja
06-11-2012, 05:23 AM
Sorry about the indenting... for some reason, I could not get that right...

moose123
06-11-2012, 07:59 AM
Thank you guys for you help!

Thank you Teeroy! code works great!


to CodeNinja
I tried i and k = 2 to but I had an error:

"sub or function not defined"

Sub myMacro()
Dim i As Long
Dim k As Long
i = 2
k = 2
Do While Cells(i, 4) <> ""
Do While Cells(k, 3) <> ""

If daysdiff(Cells(i, 4), Cells(k, 4)) >= 365 Then Cells(k, 5) = 0
k = k + 1

Loop
i = i + 1
Loop
End Sub

Would be fine if my code will work too )

CodeNinja
06-11-2012, 08:04 AM
Moose,
Glad you got your code up and running... As far as the not defined error did you create/change the name of the function to daysdiff?

Really doesn't matter if you are happy with the results.

When you get a moment, please mark this thread as resolved. Thanks and have a great day.

moose123
06-11-2012, 09:20 PM
Thanks again
But I didn't understand what you mean "create/change the name of the function to daysdiff? "
I think I need resolve this error to make it not happen in future

my code looks like

Sub myMacro()
Dim i As Long
Dim k As Long
i = 2
k = 2
Do While Cells(i, 4) <> ""
Do While Cells(k, 3) <> ""

If daysdiff(Cells(i, 4), Cells(k, 4)) >= 365 Then Cells(k, 5) = 0
k = k + 1

Loop
i = i + 1
Loop
End Sub

CodeNinja
06-12-2012, 03:57 AM
Moose,
That code should work, assuming you took the function you started with and made the alterations I suggested... so it should look like this (sorry about the spacing / indenting

Sub myMacro()
Dim i As Long
Dim k As Long
i = 2
k = 2
Do While Cells(i, 4) <> ""
Do While Cells(k, 3) <> ""
If daysdiff(Cells(i, 4), Cells(k, 4)) >= 365 Then Cells(k, 5) = 0
k = k + 1
Loop i = i + 1
Loop
End Sub

Function DaysDiff(ByVal Date1 As Date, ByVal Date2 As Date) As Integer
Dim ldate1 As Long
Dim ldate2 As Long
ldate1 = CLng(Date1)
ldate2 = CLng(Date2)
DaysDiff = ldate1 - ldate2
If DaysDiff < 0 Then
DaysDiff = DaysDiff * -1
End If
End Function

moose123
06-12-2012, 06:21 AM
Thank you CodeNinja!