简体   繁体   中英

My vba loop pulls back all the correct data when I step through but when I run the Macro it does not

I have tried to build a loop that pulls back certain data when it meets a criteria, then posts the results in my 'Main' sheet.

Unfortunately, when you run the macro it does not pull back all of the data.

However, and this in my opinion is super weird, when you step through it does.

There are no error messages at any point in the code and the code runs the whole way through if you step through/just run the macro.

I have posted my code below:

Sub Loop_Data()
    'BR stands for Blank Row
    Dim i As Integer, j As Integer, k As Integer, m As Integer, BRMAin As Integer, BRData As Integer, BRPhysNot As Integer, _
    SearchRange As Range, strID As String, ExtEnd As Integer, FindRow As Range

    BRMAin = Sheets("Main").Cells(Rows.Count, "W").End(xlUp).Row
    BRData = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
    BRPhysNot = Sheets("PhysNot").Cells(Rows.Count, "A").End(xlUp).Row

    Set SearchRange = Sheets("Data").Range("A3:A" & BRData)
    Sheets("CoData").Activate
    'assign j for number of rows (units) and i to start at 6 (column J) and end at 21

    For j = 2 To 48
        i = 35
        Do Until i = 52
                'criteria 
            If Cells(j, i - 1).Interior.Color <> RGB(51, 51, 51) And Cells(j, i - 1) > 0 And Cells(j, i).Interior.Color = RGB(51, 51, 51) Then
                'find duration o
                m = 0
                Do While Cells(j, i + m).Interior.Color = RGB(51, 51, 51)
                    m = m + 1
                Loop
                'check that the flagged is definitely matching criteria
                If Cells(j, i + m) = 0 Then
                    'set string ID as the string of uni & period to find in the helper column of Data sheet
                    'set k as row which that occurs in
                    strID = Cells(1, i) & Cells(j, 3)
                    Set FindRow = SearchRange.Find(strID)
                    k = FindRow.Row
                    'Pull back data into main sheet
                    ThisWorkbook.Sheets("Main").Range("X" & BRMAin + 1) = Sheets("Data").Cells(k, 8)
                    ThisWorkbook.Sheets("Main").Range("V" & BRMAin + 1) = Sheets("Data").Cells(k, 4)
                    ThisWorkbook.Sheets("Main").Range("W" & BRMAin + 1) = Sheets("Data").Cells(k, 2)
                    ThisWorkbook.Sheets("Main").Range("Y" & BRMAin + 1) = m
                    ThisWorkbook.Sheets("Main").Range("Z" & BRMAin + 1) = Sheets("CoData").Cells(1, i)
                End If
            End If
            i = i + 1
        Loop
    Next j
End Sub   

If a Wait or DoEvents doesn't work, instead of using

Set FindRow = SearchRange.Find(strID)
k = FindRow.Row

You could go with

k = 0
For Each SearchCell In SearchRange
    If SearchCell.Text = strID Then k = SearchCell.Row
Next

I'm not 100% sure, but I suspect it has to do with you having multiple sheets, but you aren't being specific about which sheet your ranges are calling to. I'd add in call out to worksheets for each range and cell. See my code below and let me know if it helps.

Sub Loop_Data() 'loops through CoData Sheet

'BR stands for Blank Row
Dim wb As Workbook, wsData As Worksheet, wsMain As Worksheet, wsPhys As Worksheet, wsCoData As Worksheet
Dim i As Integer, j As Integer, k As Integer, m As Integer, BRMAin As Integer, BRData As Integer, BRPhysNot As Integer
Dim SearchRange As Range, strID As String, ExtEnd As Integer, FindRow As Range

Set wb = ThisWorkbook
Set wsData = wb.Sheets("Data")
Set wsMain = wb.Sheets("Main")
Set wsPhys = wb.Sheets("PhysNot")
Set wsCoData = wb.Sheets("CoData")

BRMAin = wsMain.Cells(Rows.Count, "W").End(xlUp).Row
BRData = wsData.Cells(Rows.Count, "A").End(xlUp).Row
BRPhysNot = wsPhys.Cells(Rows.Count, "A").End(xlUp).Row

Set SearchRange = wsData.Range("A3:A" & BRData)
wsCoData.Activate 'Not necessary to activate a sheet if you need to pull data from it if you link a range to a specific sheet.
'assign j for number of rows (units) and i to start at 6 (column J) and end at 21
For j = 2 To 48

    i = 35
    Do Until i = 52
        'criteria
        If wsCoData.Cells(j, i - 1).Interior.Color <> RGB(51, 51, 51) And wsCoData.Cells(j, i - 1) > 0 And wsCoData.Cells(j, i).Interior.Color = RGB(51, 51, 51) Then

            'find duration o
            m = 0
            Do While wsCoData.Cells(j, i + m).Interior.Color = RGB(51, 51, 51)
                m = m + 1
            Loop

            'check that the flagged is definitely matching criteria
            If wsCoData.Cells(j, i + m) = 0 Then
                'set string ID as the string of uni & period to find in the helper column of Data sheet
                'set k as row which that occurs in
                strID = wsCoData.Cells(1, i) & wsCoData.Cells(j, 3)
                Set FindRow = SearchRange.Find(strID)
                k = FindRow.Row

                'Pull back data into main sheet
                wsMain.Range("X" & BRMAin + 1) = wsData.Cells(k, 8)
                wsMain.Range("V" & BRMAin + 1) = wsData.Cells(k, 4)
                wsMain.Range("W" & BRMAin + 1) = wsData.Cells(k, 2)
                wsMain.Range("Y" & BRMAin + 1) = m
                wsMain.Range("Z" & BRMAin + 1) = wsCoData.Cells(1, i)
            End If
        End If

        i = i + 1
    Loop
Next j

End Sub    

I had to guess on the unlabeled ranges, I just assumed they had to do with the CoData Worksheet since that is what you had active last.

Also, if it helps at all, I noticed you keep calling out to a specific color, you can make that a variable too so you don't have keep typing it so much. See below.

Dim grey as Long
grey = RGB(51, 51, 51)

'Colors are just stored as Longs, in some cases Integer will work, but its mostly safer to just always stick to Long. 
'So your grey would equal 3355443: 51 + 51*256 + 51 *256*256

'Example Uses...
If wsCoData.Cells(j, i - 1).Interior.Color <> grey And wsCoData.Cells(j, i - 1) > 0 And wsCoData.Cells(j, i).Interior.Color = grey Then
    '...Your code
End if

Do While Cells(j, i + m).Interior.Color = grey
    m = m + 1
Loop

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM