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.