Hmmm, where do I begin?

[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

 

[Trevor Shuttleworth]

See the reply to your other post

Regards

Trevor

 

[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