4

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   
Community
  • 1
  • 1
Gboz
  • 41
  • 2
  • I've read that [adding a sleep may help](https://www.mrexcel.com/forum/excel-questions/412764-macro-works-stepping-through-but-not-when-i-run-excel-2003-a.html#post2070738). It did for them (partially). – Timothy G. Jan 30 '17 at 15:04
  • 2
    What happens when you run it without stepping through? Does it fail to do anything, or does it do half the job and then stop? – jsheeran Jan 30 '17 at 15:04
  • Is it a lag in the find, does `worksheetfunction.match` give you anything. try after findRow `debug.print "J is " & j & " k is " & k & " strid is " & strid`, see if `K` is not working somewhere. – Nathan_Sav Jan 30 '17 at 15:13
  • I tried sleep and wait functions but neither works. When you step through or run the macro there are no error messages. When run the macro the whole code is executed but only partial results are produced. When you step through the code it is all executed but all the results are returned. – Gboz Feb 02 '17 at 10:13

2 Answers2

0

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
CLR
  • 11,284
  • 1
  • 11
  • 29
  • I tried inserting the alternative approach you suggested @CLR but still the same problem. The code pulls back all the data when you step through but only partial when you run the macro. Still no error messages. – Gboz Feb 02 '17 at 10:10
0

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
Jason Brady
  • 1,560
  • 1
  • 17
  • 40
  • Thanks for your response Jason, I will try the suggested improvements to my code at some point today/tomorrow and update you. – Gboz Feb 01 '17 at 10:22
  • I made the suggested changes @jason but unfortunately the macro still runs but does not pull back all of the data – Gboz Feb 02 '17 at 09:48