I am not sure how to complete this task, I am attempting to use loops but I am not too familiar with making them successful. I think I might need two loops going, one inside another but hopefully the experts here can help me.
What I want to accomplish:
I want to loop through cells U156:X167 and find the matching values in cells Q172:Q65536 (I made Q65536 this as the row value will change. Maybe there is a better way to go through Q172 until no value isfound in that column?) The cell value in range U156:X167 and the cell value’s to match in Q172:Q65536 will always be exact.
Once I find the matching value I want select thematching value in Q172:Q65536 and offset(0,4).value and put that value in rangeU156:X167.offset(0,4).value thencontinue the loop until the code has gone through cells U156 through X167matching the cells values then offsetting to input that corresponding value
Below is what I have so far. I have rearranged this code a few different times to see if it will work and excel doesn’t seem to ever execute this code. I want it to be a Worksheet_Change(ByVal target As range)and only execute when the value of U156:X167 has changed. I get an error onthis line:
If myrange.cells(i, 0).value = comb_range.value Then as type 13 mismatch
The top If Not Application.Intersect(activecell, range("O156:P167"))Is Nothing This code works great, it’s the If NotApplication.Intersect(activecell, range("U156:X167")) Is Nothing Then portion that isn’t working as intended. I appreciate any help!
What I want to accomplish:
I want to loop through cells U156:X167 and find the matching values in cells Q172:Q65536 (I made Q65536 this as the row value will change. Maybe there is a better way to go through Q172 until no value isfound in that column?) The cell value in range U156:X167 and the cell value’s to match in Q172:Q65536 will always be exact.
Once I find the matching value I want select thematching value in Q172:Q65536 and offset(0,4).value and put that value in rangeU156:X167.offset(0,4).value thencontinue the loop until the code has gone through cells U156 through X167matching the cells values then offsetting to input that corresponding value
Below is what I have so far. I have rearranged this code a few different times to see if it will work and excel doesn’t seem to ever execute this code. I want it to be a Worksheet_Change(ByVal target As range)and only execute when the value of U156:X167 has changed. I get an error onthis line:
If myrange.cells(i, 0).value = comb_range.value Then as type 13 mismatch
The top If Not Application.Intersect(activecell, range("O156:P167"))Is Nothing This code works great, it’s the If NotApplication.Intersect(activecell, range("U156:X167")) Is Nothing Then portion that isn’t working as intended. I appreciate any help!
Code:
Private Sub Worksheet_Change(ByVal target As range)
Dim ws4 As Worksheet
Set ws4 = Worksheets("Practice")
Dim CDstatus As String
Dim xlrange As range, xlrange2 As range, xlrange3 As range, xlrange4 As range, xlrange5 As range, xlrange6 As range
Dim valuetofind As String, valuetofind2 As String, valuetofind3 As String, valuetofind4 As String, valuetofind5 As String, valuetofind6 As String
Dim followup As String, statusdate As String
Dim r As range, r2 As range
Dim q As range, q2 As range
Dim LastRow As Long
Dim cell1 As range, cell2 As range, cell3 As range, cell4 As range, cell5 As range, cell6 As range
Dim com1 As range, com2 As range, com3 As range, com4 As range, com5 As range, com6 As range
Dim cell1L As range, cell2L As range, cell3L As range, cell4L As range, cell5L As range, cell6L As range
Dim cor1L As range, cor2L As range, cor3L As range, cor4L As range, cor5L As range, cor6L As range
Dim foundrow As String
Dim xlrange1 As range
Dim valuetofind1 As String
Dim myrange As range
Dim i As Long
Dim comb_range As range[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]
Application.EnableEvents = False
Application.ScreenUpdating = False[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000] Set cell1 = ws4.range("Q156")
Set com1 = ws4.range("U156")
Set cell1L = ws4.range("AB156")
Set cor1L = ws4.range("AB157")
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000] Set cell3 = ws4.range("Q160")
Set com3 = cell3.Offset(0, 1)
Set cell3L = ws4.range("AB160")
Set cor3L = ws4.range("AB161")
Set cell2 = ws4.range("Q158")
Set com2 = cell2.Offset(0, 1)
Set cell2L = ws4.range("AB158")
Set cor2L = ws4.range("AB159")
Set cell4 = ws4.range("Q162")
Set com4 = cell4.Offset(0, 1)
Set cell4L = ws4.range("AB162")
Set cor4L = ws4.range("AB163")
Set cell5 = ws4.range("Q164")
Set com5 = cell5.Offset(0, 1)
Set cell5L = ws4.range("AB164")
Set cor5L = ws4.range("AB165")
Set cell6 = ws4.range("Q166")
Set com6 = cell6.Offset(0, 1)
Set cell6L = ws4.range("AB166")
Set cor6L = ws4.range("AB167")
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000] If Not Application.Intersect(activecell, range("O156:P167")) Is Nothing Then
On Error GoTo errhandler
If activecell.value = "Complete" Or activecell.value = "Pending" Then
ws4.range("Z151").value = activecell.Address
Else
End If[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]begining = ws4.range("Z151").value[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000] valuetofind = activecell.Offset(0, 1).value
Set xlrange = Worksheets("Practice").range("Q172:T300")[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]
For Each cell In xlrange
If cell.value = valuetofind Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]If activecell.value = "Complete" Then
cell.Offset(0, -2).value = "Complete"
ElseIf activecell.value = "Pending" Then
cell.Offset(0, -2).value = "Pending"
Else
cell.Offset(0, -2).value = "Pending"
End If[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]cell.Offset(-1, -3).Select
ws4.range("Z152").value = activecell.Address
addr = ws4.range("Z152").value
cell.Offset(0, -3).Select
ws4.range("Z153").value = activecell.value
addr1 = ws4.range("Z153").value[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]
End If
Next[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]
strsheet = Worksheets("Practice").range("Z151").value
Worksheets("Practice").range(strsheet).Activate[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]On Error GoTo errhandler
activecell.formula = "=offset(" & addr & ",1, " & 1 & ")"[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]End If[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]If Not Application.Intersect(activecell, range("U156:X167")) Is Nothing Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Set myrange = range("Q156:T167")
Set comb_range = range("Q172:Q65536")[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]
For i = 156 To myrange.Rows.Count
If myrange.cells(i, 0).value = comb_range.value Then
myrange.Offset(0, 4).value = comb_range.Offset(0, 4).value
End If[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]i = i + 1[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]
Next i[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]
errhandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
Else
End If
Application.EnableEvents = True
Application.ScreenUpdating = True[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]
End Sub
[/COLOR][/SIZE][/FONT]
Last edited: