VBA loop isn't functioning properly

Question

Sub Button2_Click()
Dim i As Integer, q As Integer
i = 2
q = 2
Do While i < 468 And q < 3450
If Worksheets("Sheet1").Range("A" & i).Value = Worksheets("Sheet2").Range("A" & q).Value Then
    If Len(Worksheets("Sheet1").Cells(i, 4)) < 12 Then
        Dim edate As String, adate As String, ed As String, ad As String, n As Integer, x As Integer, y As Integer
        edate = Sheets("sheet1").Cells(i, 4).Value
        adate = Sheets("sheet2").Cells(q, 2).Value
        ed = Right(Sheets("sheet1").Cells(i, 4), 4)
        ad = Right(Sheets("sheet2").Cells(q, 2), 4)
        n = CInt(ad) - CInt(ed)
        If InStr(edate, "Fall") And InStr(adate, "Fall") Then x = 7 + (5 * n)
        If InStr(edate, "Fall") And InStr(adate, "Spring") Then x = 9 + (5 * (n - 1))
        If InStr(edate, "Spring") And InStr(adate, "Spring") Then x = 9 + (5 * n)
        If InStr(edate, "Spring") And InStr(adate, "Fall") Then x = 12 + (5 * n)
        y = x - 1
        Worksheets("Sheet1").Cells(i, x).Value = Worksheets("Sheet2").Cells(q, 5).Value
        Worksheets("Sheet1").Cells(i, y).Value = Worksheets("Sheet2").Cells(q, 3).Value
        i= i +1
        q=2
    Else
        i = i + 1
        q = 2
    End If
Else
    If q < 3423 Then
        q = q + 1
    else
        i = 1 + 1
        q=2
    End If
    Else
        i = i + 1
        q = 2
    End If
End If
Loop
End Sub

Hey guys, the code above is something I've been working on to important some data from sheet2 to sheet1. Sheet 2 has project Id numbers in column 1, terms (awarddate) in column 2, type of award in column 3, and amount in column 5. Sheet 1 has project id in column 1, and term (entry date) in column 4. Sheet 2 has awards given by semester and indexed by project id, I would like to important the data and place them into the columns given by the if instr statements int he middle of the text.

The goal of this code is to loop through the project id numbers in sheet 1, column A and check to see if they exist in sheet 2 column A, and then to import the award type and amount sorted by the difference in years between the entry date on sheet 1 and the award date on sheet 2. The dates have spring/fall and a year, so I tried the left(string, #) command to only have years to subtract, and then the block of aforementioned if instr code is supposed to balance out the difference in semesters.

There are multiples of the same project id in sheet 2, so I need the code to resume the loop after the previous row on sheet 2, until every project id on sheet 1 has been cross-referenced.

Can someone point out the error in my code? Nothing happens when I click the command button.

The problem is in the first if statement, it skips all of the operations that require the condition to be met, when I know that at least 450 of the data match.

Just edited my code, it's still running right now.

List of edits thanks to comments: fixed logical statment issue, fixed range/cell/cells issue, fixed looping issue, fixed right/left string issue

xpes100 · Accepted Answer

Thanks for all of the help, here is the code that works in case anyone stumbles upon this with a similar problem.

This code loops through sheet1 with integer i and sheet2 with integer q to find a match in the first/A column of both sheets. As I have multiples of the project ideas (Sheet 1 column A) on sheet2 in column A, it continues after finding a match at the row (q) found on sheet2. This then continues through the specified amount of rows (i) and secondly through all rows (q) for each i.

Public CalcState As Long
Public EventState As Boolean
Public PageBreakState As Boolean

Sub OptimizeCode_Begin()

Application.ScreenUpdating = False

EventState = Application.EnableEvents
Application.EnableEvents = False

CalcState = Application.Calculation
Application.Calculation = xlCalculationManual

PageBreakState = ActiveSheet.DisplayPageBreaks
ActiveSheet.DisplayPageBreaks = False

End Sub

Sub OptimizeCode_End()

ActiveSheet.DisplayPageBreaks = PageBreakState
Application.Calculation = CalcState
Application.EnableEvents = EventState
Application.ScreenUpdating = True

End Sub


Sub Button2_Click()
Dim i As Integer, q As Integer, origCalcMode As XlCalculation
i = 3
q = 2
Call OptimizeCode_Begin
Do While i < 467
If Len(Worksheets("Sheet1").Cells(i, 4)) < 12 Then
    If Worksheets("Sheet1").Cells(i, 1).Value = Worksheets("Sheet2").Cells(q, 1).Value Then
        Dim edate As String, adate As String, ed As String, ad As String, n As Integer, x As Integer, y As Integer
        edate = Sheets("sheet1").Cells(i, 4).Value
        adate = Sheets("sheet2").Cells(q, 2).Value
        ed = Right(Sheets("sheet1").Cells(i, 4), 4)
        ad = Right(Sheets("sheet2").Cells(q, 2), 4)
        n = CInt(ad) - CInt(ed)
        If InStr(edate, "Fall") And InStr(adate, "Fall") Then x = 7 + (5 * n)
        If InStr(edate, "Fall") And InStr(adate, "Spring") Then x = 9 + (5 * (n - 1))
        If InStr(edate, "Spring") And InStr(adate, "Spring") Then x = 9 + (5 * n)
        If InStr(edate, "Spring") And InStr(adate, "Fall") Then x = 12 + (5 * n)
        y = x - 1
        Worksheets("Sheet1").Cells(i, x).Value = Worksheets("Sheet2").Cells(q, 5).Value
        Worksheets("Sheet1").Cells(i, y).Value = Worksheets("Sheet2").Cells(q, 3).Value
        q = q + 1
    Else
        If q < 1236 Then
            q = q + 1
        Else
            i = i + 1
            q = 2
        End If
    End If
Else
   i = i + 1
   q = 2
End If
Loop
Call OptimizeCode_End
End Sub

VBA loop isn't functioning properly

Answers (2)

Related Questions

VBA loop isn&#39;t functioning properly

Answers (2)

Related Questions

VBA loop isn't functioning properly