Continuous running of Excel Macro

[Lucky0683]

Hi


I am completely new to VBA so please bear with me if my problem is basic.


I am trying to write a sub-procedure that will loop through each row in a certain column and compare to another sheet's criteria. if it contains "x", for example, then the value will be returned. However, when I try running the code, the codes run forever and causes the computer to hang.


Here's the code that I have written so far. PS: I have obtained errors when using 'Application.WorksheetFunction.Index' and when reading other threads, it was suggested to delete 'WorksheetFunction'. I'm not sure if that causes the problem and I would also like to clarify the rationale behind removing the words 'WorksheetFunction'


I would also like to see if there is a more efficient way of writing the code as I am not sure what is the last filled cell in the range (so I need a more dynamic referencing as compared to Q655536.


Thank you so much in advance!




Sub sub_Input()


Dim ws As Worksheet: Set ws = ActiveSheet
Dim rng As Range
Set rng = ws.Range("Q4:Q655536")
Dim rngCell As Range


On Error Resume Next
For Each rngCell In rng




If rngCell.Offset(0, -13) = "x" Then
rngCell = Application.Index(Sheets("Data").Range _
("D805:D813"), Application.Match(rngCell.Offset(0, -15), Sheets("Data").Range _
("D805:D813"), 1))
ElseIf rngCell.Offset(0, -13) = "y" Then
rngCell = Application.Index(Sheets("Data").Range _
("D27:D34"), Application.Match(rngCell.Offset(0, -15), Sheets("Data").Range _
("D27:D34"), 1))
ElseIf rngCell.Offset(0, -13) = "z" Then
rngCell = Application.Index(Sheets("Data").Range _
("D718:D726"), Application.Match(rngCell.Offset(0, -15), Sheets("Data").Range _
("D718:D726"), 1))
Else: rngCell = vbNullString
End If




Next rngCell




Set rngCell = Nothing
Set rng = Nothing


End Sub

 

[offthelip]

Your code is very inefficient and I suspect the excel is running out of resources. you are running a loop round the whole range from 4 to 655 thousand looking at each cell in turn this is going to take minutes to run even if it does run.
I suggest as a first start you change the statement:

[COLOR=#333333]Set rng = ws.Range("Q4:Q655536")[/COLOR]

to either a fixed sensible smaller range or detect the last row with values in it using code like this:

LastRow = Cells(rows.Count, "Q").End(xlUp).Row
[COLOR=#333333]Set rng = ws.Range("Q4:Q" & Lastrow)[/COLOR]

However to do this really efficiently you need to use variant arrays instead of looping through the worksheet, have a look at this thread for a faster more flexible way of doing a vlookup in VBA
https://www.mrexcel.com/forum/excel-questions/1043185-vlookup-vba-alternative.html