Looping through range and entering values

N

Nichole09

Board Regular
Joined
Aug 27, 2016
Messages
132
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!



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:

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
Sort by date Sort by votes
I am not sure why it broke out my code like it did. I will attempt to re-enter my code so its easier to see.

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

Application.EnableEvents = False
 Application.ScreenUpdating = False
 Set cell1 = ws4.range("Q156")
 Set com1 = ws4.range("U156")
 Set cell1L = ws4.range("AB156")
 Set cor1L = ws4.range("AB157")
 
 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")
 
 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
begining = ws4.range("Z151").value
 valuetofind = activecell.Offset(0, 1).value
Set xlrange = Worksheets("Practice").range("Q172:T300")

For Each cell In xlrange
If cell.value = valuetofind Then
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


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

End If
Next

strsheet = Worksheets("Practice").range("Z151").value
Worksheets("Practice").range(strsheet).Activate
On Error GoTo errhandler
activecell.formula = "=offset(" & addr & ",1, " & 1 & ")"
End If
If Not Application.Intersect(activecell, range("U156:X167")) Is Nothing Then
Set myrange = range("Q156:T167")
Set comb_range = range("Q172:Q65536")

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
i = i + 1

Next i

errhandler:
Application.EnableEvents = True
 Application.ScreenUpdating = True
 
 Else
 
 End If
 
 
 Application.EnableEvents = True
 Application.ScreenUpdating = True

End Sub
Private Sub worksheet_selectionchange(ByVal target As range)
Set ws4 = Worksheets("Practice")
Dim CDstatus As String
Dim followup As String, statusdate As String
Dim r As range, r2 As range
Dim q As range, q2 As range
Dim i As Variant
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 xlrange As range
Dim valuetofind As String
Dim correct_value As String
   Application.EnableEvents = False
 Application.ScreenUpdating = False
 If Not Application.Intersect(activecell, range("U156:X167")) Is Nothing Then
 If activecell.value <> "" Then

valuetofind = activecell.Offset(0, -4).value
Set xlrange = Worksheets("Practice").range("Q172:T300")
For Each cell In xlrange
If cell.value = valuetofind Then
foundrow = cell.Offset(0, 1).Row
ws4.range("H157").value = ("U" & foundrow)
activecell.value = ws4.range("U" & foundrow).value
End If
Next
 
 Else
  
 End If
 End If
 
 
 
    Application.EnableEvents = True
 Application.ScreenUpdating = True
 
End Sub
 
Upvote 0
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.

[FONT=&quot]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[/FONT]
Click to expand...

This code will do what you describe here, which seems to be a bit different from what your code does . Hoefully is shows you a much simpler way of doing what you are trying to do:
Code: 
Sub test()

lastrow = Cells(Rows.Count, "Q").End(xlUp).Row
inarr = Range("U156:U167")
marr = Range("Q172:U" & lastrow)
For i = 1 To 12
 For j = 1 To UBound(marr)
  If inarr(i, 1) = marr(j, 1) Then
   Application.EnableEvents = False
   Cells(155 + i, 25) = marr(j, 5)
   Application.EnableEvents = True
   Exit For
  End If
 Next j
Next i
End Sub
 
Upvote 0
offthelip your code was far less complicated then what I was trying to do. lol thank you!! I used your code to suit my needs and it works great! thank you for the help!! :)

Code: 
 If Not Application.Intersect(activecell, range("U156:X168")) Is Nothing Then
 
LastRow = cells(Rows.Count, "Q").End(xlUp).Row
LastRow1 = cells(Rows.Count, "U").End(xlUp).Row
inarr = range("Q156:Q167")
marr = range("Q172:Q" & LastRow)
marr1 = range("U156:U167")
For i = 1 To 12
 For j = 1 To UBound(marr)
  If inarr(i, 1) = marr(j, 1) Then
   Application.EnableEvents = False
    cells(171 + j, 21) = marr1(i, 1)
   Exit For
  End If
 Next j
Next i

End If
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
With 'Set StrVal=ActiveCell.Address' and ‘Dim StrVal As String’ I get 'Object required' error With ‘Dim StrVal As Range’, a ‘Type Mismatch’ error
Replies
7
Views
162
MARK858
MARK858
D
  • Solved
TextBox looping help required in VBA
Replies
3
Views
385
DanteAmor
DanteAmor
Young Grasshopper
  • Solved
Excel VBA / Loop to copy unknown number of columns underneath each other, and string to each cell, AND adjecent cells!
Replies
4
Views
590
kevin9999
K
J
  • Solved
Loop taking hours to copy values
Replies
5
Views
393
jakel27
J
C
  • Solved
Need help setting up multiple sheets as source worksheets. Trying to loop through multiple sheets to consolidate data into a master sheet
2 3
Replies
25
Views
1K
ccastro4
C

Forum statistics

Threads
1,214,915
Messages
6,122,212
Members
449,074
Latest member
cancansova

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top