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

Is i = i + 1 And q = 2 really meant to be a logical expression, or is this meant to be two statements, i.e. i = i + 1: q = 2? — YowE3K
– YowE3K, Commented Feb 1, 2017 at 18:43
Nothing happens when I click the command button - Have you tried to point out the error in your code by debugging (running through the code line-by-line and seeing what results happen by checking variable values and such). — Scott Holtzman
– Scott Holtzman, Commented Feb 1, 2017 at 18:46
Don't use a logical operator when you should use a statement separator. — YowE3K
– YowE3K, Commented Feb 1, 2017 at 18:47
Create a MessageBox right after Sub Button2_Click() to make sure the script is running. — UndeadBob
– UndeadBob, Commented Feb 1, 2017 at 18:54
Are you sure that they are numbers? Switch formatting to general and make sure leading zeroes disappear, or use a format of "#,##0" and make sure commas appear. (P.S. Once you get past that line, your .cell methods will fail. They should be the .Cells property.) Why are you even using Like if they are 9 digit numbers, wouldn't you want to check for equality? — YowE3K
– YowE3K, Commented Feb 1, 2017 at 19:06

YowE3K · Accepted Answer · 2017-02-02 00:57:38Z

1

Can I suggest that you refactor your code as follows:

Sub Button2_Click()
    Dim i As Integer, q As Integer
    'Storing the ids in an array will make it much faster to access instead
    'of interfacing with Excel's object model a couple of million times
    Dim ids1, ids2
    Dim origCalcMode As XlCalculation

    'Switch off ScreenUpdating to improve speed
    Application.ScreenUpdating = False
    'Switch off auto calculation to improve speed
    origCalcMode = Application.Calculation
    Application.Calculation = xlCalculationManual

    ids1 = Application.Transpose(Worksheets("Sheet1").Range("A2:A467").Value)
    ids2 = Application.Transpose(Worksheets("Sheet2").Range("A2:A3422").Value)
    'Using For loops rather than manually keeping track of row counters
    'makes the code MUCH cleaner and less prone to errors
    For i = 2 To 467
        'Moving this test to earlier in the code avoids having to iterate
        'through all the rows on Sheet2 when there is nothing that can be
        'done with the matching data anyway
        If Len(Worksheets("Sheet1").Cells(i, 4)) < 12 Then
            For q = 2 To 3422
                If ids1(i - 1) = ids2(q - 1) 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
                    Exit For
                End If
            Next
        End If
    Next

    'Restore application settings
    Application.ScreenUpdating = True
    Application.Calculation = origCalcMode
End Sub

I'm not sure about the Exit For line. Your question implies that you need to process multiple entries from Sheet2 if they exist. If so, delete the Exit For line, but that will increase the runtime because it will need to iterate over all 3421 rows in Sheet2 for each row in Sheet1.

Edit: Included changes to ScreenUpdating and Calculation as suggested by BruceWayne.

edited Feb 2, 2017 at 0:57

answered Feb 1, 2017 at 18:48

YowE3K

24k7 gold badges28 silver badges45 bronze badges

Sign up to request clarification or add additional context in comments.

5 Comments

BruceWayne Over a year ago

@xpes100 - nothing happens at all? What if you step through the code with F8, you can hover the mouse over variables and see if it's updating them as you expect, or you can kind of "trace" where the macro is going wrong.

YowE3K Over a year ago

@BruceWayne - the OP's comment above is left over from my very first attempt at answering the question (i.e. when the code included i = i + 1 And q = 2). Apparently the OP's code is now working (or, at least, doing something), but just taking a long time to run.

BruceWayne Over a year ago

Do you think turning off auto calculation and screen updating would help any, with the speed?

YowE3K Over a year ago

@BruceWayne - Probably help a little, but there's a maximum of 932 cell writes so I can't see screen updating being a major cause of slowness, and I'm guessing that there won't be many calculations dependent on the updated cells (it just doesn't seem to be a calculation-intensive type of application). I'll edit the code anyway.

Shai Rado Over a year ago

not a big fan of using With Worksheets("Sheet1") in the begining ? would have made the code a lot cleaner and shorter.

xpes100 · Accepted Answer · 2017-02-06 20:04:16Z

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

Collectives™ on Stack Overflow

VBA loop isn't functioning properly

2 Answers 2

5 Comments

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

5 Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Related