Hmmm, Where do I begin???

L

loren.pottinger

Ok well my goal is to start out by using the DateAdd function to add
the number of months in column F to Colum H and comare it to Column I.
If that date is < the Date in Column I, then copy the data K of the
corresponding Row and paste Starting in colum M of the same row. If
that date is > than the date in Column I, a zero is placed in that
cell. Repeat this step all the way to Colum AC. These steps are then
repeated on the next row, and the next and so forth until the program
arrives at cell M64. My current error is "Loop without Do" This is not
the case as all DOs have a corresponding Lopp. Please Help. My Code is
as follows:

Dim PayRange As Range
Dim TestRange1, TestRange2, TestRange3 As Range
Dim TestDate As Date
Dim CurrentColumn As Column

Dim RowNumber As Integer

Range("M7").Select

Do While ActiveCell <> Range("M64")

RowNumber = ActiveCell.Row
'MsgBox RowNumber
TestRange1 = "F" & RowNumber
TestRange2 = "H" & RowNumber
TestRange3 = "I" & RowNumber
PayRange = "K" & RowNumber


TestDate = DateAdd("m", Range("TestRange1").Value,
Range("TestRange2").Value)

If TestDate < Range("TestRange3").Value Then

Call ChoosePasteColumn

Else:
ActiveCell.Offset(0, 2).Select
If ActiveCell.IsEmpty = True Then
ActiveCell.Value = 0
Else

Do Until IsEmpty(ActiveCell.Value)
ActiveCell.Offset(0, 1).Select
Loop
ActiveCell.Value = 0

End If

If CurrentColumn = "AD" Then
ActiveCell.Offset(1, 17).Select

ElseIf CurrentColumn = "AC" Then
ActiveCell.Offset(1, 16).Select
End If
Loop

End Sub

Function ChoosePasteColumn()

Dim RowNumber As Integer
Dim PayRange As Range

RowNumber = ActiveCell.Row
PayRange = "K" & RowNumber

ActiveCell.Offset(0, 2).Select
Do While ActiveCell.Column <> Range("AD:AD")

Do While ActiveCell.Value = Empty

Range("PayRange").Select
Selection.Copy
ActiveSheet.Paste
ActiveCell.Offset(0, 1).Select

Loop

Loop
End Function
 
T

Trevor Shuttleworth

Yep, you've got all your loops and dos but you're missing an End If

If TestDate < Range("TestRange3").Value Then
Call ChoosePasteColumn
Else
ActiveCell.Offset(0, 2).Select
If ActiveCell.IsEmpty = True Then
ActiveCell.Value = 0
Else
Do Until IsEmpty(ActiveCell.Value)
ActiveCell.Offset(0, 1).Select
Loop
ActiveCell.Value = 0
End If ' <<<<<<<<<<<
End If

It's easier to read if you indent the code and then you can match up the Ifs
and End Ifs.

Regards

Trevor
 
L

loren.pottinger

I have made some changes and now my code compiles, but no results,
please help.

Sub GetAmOrDep()

Dim PayRange As Range
Dim TestRange1, TestRange2, TestRange3 As Range
Dim TestDate As Date
Dim CurrentColumn As Column
Dim RowNumber As Integer

Range("M7").Select

Do While ActiveCell <> Range("M64")

Do While ActiveCell.Column <> Range("AD:AD")

RowNumber = ActiveCell.Row

TestRange1 = "F" & RowNumber
TestRange2 = "H" & RowNumber
TestRange3 = "I" & RowNumber
PayRange = "K" & RowNumber


TestDate = DateAdd("m", Range("TestRange1").Value,
Range("TestRange2").Value)

If TestDate < Range("TestRange3").Value Then

Range("PayRange").Select
Range("PayRange").Value.Copy
Selection.Copy
ActiveCell.Offset(0, 2).Select


If ActiveCell.Value = Empty Then
ActiveSheet.Paste
Else

Do Until IsEmpty(ActiveCell.Value)
ActiveCell.Offset(0, 1).Select
ActiveSheet.Paste
Loop
End If

ActiveCell.Offset(0, 1).Select
TestRange1 = TestRange1 - 1


Else:

ActiveCell.Offset(0, 2).Select

If IsEmpty(ActiveCell.Value) Then
ActiveCell.Value = 0

Else

Do Until IsEmpty(ActiveCell.Value)
ActiveCell.Offset(0, 1).Select
Loop

ActiveCell.Value = 0
TestRange1 = TestRange1 - 1

End If

End If

Loop

If CurrentColumn = "AD" Then
ActiveCell.Offset(1, 17).Select

ElseIf CurrentColumn = "AC" Then
ActiveCell.Offset(1, 16).Select

End If

Loop

End Sub

Thank you,

Loren
 
T

Trevor Shuttleworth

Loren

you really need to step through the code and see what it is trying to do.

Various things you should change firts:

'Dim CurrentColumn As Column doesn't seem to work for me - can't dim
something as column. That stops me straight away so I have remmed it out.

You could use:

If ActiveCell.Column = 30 Then

rather than:

If CurrentColumn = "AD" Then


Dim TestRange1, TestRange2, TestRange3 As Range only defines TestRange3 as a
Range; the other two are variants. When you try to use them you are
actually creating strings with addresses in them.

Hence you need to take out the quote marks in the following statements:

TestDate = DateAdd("m", Range(TestRange1).Value,
Range(TestRange2).Value)
If TestDate < Range(TestRange3).Value Then
Range(PayRange).Select
Range(PayRange).Value.Copy

This statement:

Do While ActiveCell.Column <> Range("AD:AD").Column

jumps over column AD because it starts at M7 and increments by 2 so you'll
never get 30 and stop this part of the loop.

This statement compares values/content:

Do While ActiveCell <> Range("M64")

Whilst this compares the addresses of the cells (which is what I think you
want ?)

Do While ActiveCell.Address <> Range("M64").Address

(Unless there is a value in M64 that you are looking for, in which case,
cancel the last remark)

You are moving across the columns but checking down the rows to terminate
your loop

ActiveCell.Offset(0, 2).Select is moving to the right, two
columns at a time

So, O7 and Q7 get set to zero ... in fact, every other x7 gets set to zero
till you fall off the side of the sheet. You'll get a Run time error '1004'

I have no idea what your data looks like so I can only guess at how the
comparisons are working out for you.

Short story, I can't get it to work but I've found a few bugs which won't
help.

As I said, if you step through the code you'll see what is happening


Amended code below:

Sub GetAmOrDep()

Dim PayRange
Dim TestRange1, TestRange2, TestRange3
Dim TestDate As Date
'Dim CurrentColumn As Column
Dim RowNumber As Integer

Range("M7").Select

Do While ActiveCell.Address <> Range("M64").Address
Do While ActiveCell.Column <> Range("AD:AD").Column
RowNumber = ActiveCell.Row
TestRange1 = "F" & RowNumber
TestRange2 = "H" & RowNumber
TestRange3 = "I" & RowNumber
PayRange = "K" & RowNumber
TestDate = DateAdd("m", Range(TestRange1).Value,
Range(TestRange2).Value)
If TestDate < Range(TestRange3).Value Then
Range(PayRange).Select
Range(PayRange).Value.Copy
Selection.Copy
ActiveCell.Offset(0, 2).Select
If ActiveCell.Value = Empty Then
ActiveSheet.Paste
Else
Do Until IsEmpty(ActiveCell.Value)
ActiveCell.Offset(0, 1).Select
ActiveSheet.Paste
Loop
End If
ActiveCell.Offset(0, 1).Select
TestRange1 = TestRange1 - 1
Else:
ActiveCell.Offset(0, 2).Select
If IsEmpty(ActiveCell.Value) Then
ActiveCell.Value = 0
Else
Do Until IsEmpty(ActiveCell.Value)
ActiveCell.Offset(0, 1).Select
Loop
ActiveCell.Value = 0
TestRange1 = TestRange1 - 1
End If
End If
Loop
If ActiveCell.Column = 30 Then
ActiveCell.Offset(1, 17).Select
ElseIf ActiveCell.Column = 29 Then
ActiveCell.Offset(1, 16).Select
End If
Loop
End Sub
 
L

loren.pottinger

Thanks for taking the time to help Trevor. I'm going through the code
now.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Hmmm, where do I begin? 2
loop until empty row and column problem (format cells until the lastrow and column in a report) 4
Pausing VBA execution to allow for full recalculation 1
delete duplicates 0
Insert Row/Copy with Autofilter 4
works in 2007 but not in 2010 0
Error 2042 problem with vlookup 0
ActiveCell.Offset(i, 0) = Chr(ActiveCell.Row + 62) returns all A's 4

Top