Improve VBA running time
- or -
Post a project like this1078
£200(approx. $251)
- Posted:
- Proposals: 8
- Remote
- #3255044
- OPPORTUNITY
- Awarded
Description
Experience Level: Entry
I need a VBA professional to optimize / improve my code , so I have less running time I deal with about 1000000 rows
I am trying to find each cell value in column A of worksheet "OFSHC" in worksheet "User Assessments" and if value found then return "true" in column V of the corresponding cell in worksheet "OFSHC" else return "False". I have the code below , however; I am working with +90000 rows in worksheet "OFSHC" and +900000 rows in sheet "User Assessments" , which makes the code to run over 6 hours.
Code:
Sub findUsername_OFSHC_User_Assessments()
Worksheets("OFSHC").Activate
Dim FindString As String
Dim Rng As Range
For Each Cell In Range("A2:A90000")
FindString = Cell.Value
If Trim(FindString) <> "" Then
With Sheets("User Assessments").Range("D2:D900000")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.GoTo Rng, True
Cell.Offset(0, 22).Value = "True"
Else
Cell.Offset(0, 22).Value = "False"
End If
End With
End If
Next
End Sub
I am trying to find each cell value in column A of worksheet "OFSHC" in worksheet "User Assessments" and if value found then return "true" in column V of the corresponding cell in worksheet "OFSHC" else return "False". I have the code below , however; I am working with +90000 rows in worksheet "OFSHC" and +900000 rows in sheet "User Assessments" , which makes the code to run over 6 hours.
Code:
Sub findUsername_OFSHC_User_Assessments()
Worksheets("OFSHC").Activate
Dim FindString As String
Dim Rng As Range
For Each Cell In Range("A2:A90000")
FindString = Cell.Value
If Trim(FindString) <> "" Then
With Sheets("User Assessments").Range("D2:D900000")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.GoTo Rng, True
Cell.Offset(0, 22).Value = "True"
Else
Cell.Offset(0, 22).Value = "False"
End If
End With
End If
Next
End Sub
Mohamed E.
100% (9)Projects Completed
7
Freelancers worked with
2
Projects awarded
70%
Last project
29 Apr 2021
United Kingdom
New Proposal
Login to your account and send a proposal now to get this project.
Log inClarification Board Ask a Question
-
There are no clarification messages.
We collect cookies to enable the proper functioning and security of our website, and to enhance your experience. By clicking on 'Accept All Cookies', you consent to the use of these cookies. You can change your 'Cookies Settings' at any time. For more information, please read ourCookie Policy
Cookie Settings
Accept All Cookies