Find a value in a column in excel vba


Board Regular
Aug 20, 2016
I am trying to write vba code to do the following:
Step 1. Read an excel file.
Step 2. Store the value in Variables.
Step 3. Find a matching value in a another file column stored in variable.
Step 4. Check 1 other variable to ensure record match.
Step 5. If record matches then add a string "left employee" to a third column of the same record.
Later to be added will be step 6 to basically delete the record.

Is there an easy way to do this.
I am stuck where it basically loops through the entire 2500 records for each record.
There may be multiple records in the destination database.
Trying to store the original file data in an array would that help?
Syntax seems to be incorrect.

My current code is listed below:

Sub DeleteLeft()


Dim CurrDir As String
Dim NewDir As String
Dim OldName As String
Dim NewName As String

CurrDir = "F:\Corporate\Anshika\Due Dates\left"
'MsgBox CurrDir
NewDir = "F:\Corporate\Anshika\Due Dates\left\Archive"
'MsgBox NewDir

If Right(CurrDir, 1) <> "\" Then CurrDir = CurrDir & "\"
If Right(NewDir, 1) <> "\" Then NewDir = NewDir & "\"

'MsgBox CurrDir
'MsgBox NewDir

OldName = Dir(CurrDir & "*.xls")
'MsgBox OldName
NewName = "Left.xls"
'MsgBox NewName

FileCopy CurrDir & OldName, NewDir & OldName
MsgBox "File Copied to Archive"
Name CurrDir & OldName As CurrDir & NewName
MsgBox CurrDir & OldName & " renamed as " & CurrDir & NewName

'***********OPEN LEFT FILE************************************************

Workbooks.Open Filename:="F:\Corporate\Anshika\Due Dates\left\left.xls*"
'***********CHANGE TO UPPER CASE*********
Range("A1:x100") = [index(upper(A1:x100),)]

'Read total no of records in file
Dim recordcount As Integer
recordcount = Worksheets("Out").UsedRange.Rows.Count
'MsgBox "total records " & recordcount
Dim leftcurrrecord As Integer


Dim HeaderRowLeft As Integer
'HeaderRowLeft = WorksheetFunction.Match("*CODE*", ActiveWorkbook.Sheets("Out").Range("a1:x100"), 0)
HeaderRowLeft = Worksheets("Out").Range("a1:x100").Find("*Code*").Row
'MsgBox HeaderRowLeft

Dim ColNumLeftEmpName As Integer
ColNumLeftEmpName = Worksheets("Out").Range("a1:x100").Find("*Nam*Emp*").Column
'MsgBox "Emp Name Col :" & ColNumLeftEmpName

Dim ColNumLeftDept As Integer
ColNumLeftDept = Worksheets("Out").Range("A1:x100").Find("*Department*").Column
'MsgBox ColNumLeftDept

Dim ColNumLeftEmpID As Integer
ColNumLeftEmpID = Worksheets("Out").Range("A1:x100").Find("*CODE*").Column
'MsgBox ColNumLeftEmpID

MsgBox "Total Number of Employees Left is " & recordcount - HeaderRowLeft

leftcurrrecord = HeaderRowLeft + 1
'MsgBox " Row 1 with record is " & leftcurrrecord


Dim arrayrecords As Integer
arrayrecords = recordcount - HeaderRowLeft
Dim MyArray(1 To 2, HeaderRowLeft To arrayrecords) As Variant
MyArray(1, 1) = Cells(leftcurrrecord, ColNumLeftEmpID).Value
MsgBox MyArray

Dim LeftEmpCode As String
Dim LeftEmpName As String
Dim LeftEmpDept As String

LeftEmpCode = Cells(leftcurrrecord, ColNumLeftEmpID).Value
LeftEmpName = Cells(leftcurrrecord, ColNumLeftEmpName).Value
LeftEmpDept = Cells(leftcurrrecord, ColNumLeftDept).Value

MsgBox LeftEmpCode & " " & LeftEmpName & " " & LeftEmpDept

'****************activating Database******************

Workbooks("DD DATABASE.xlsm").Activate

'**************Adding remarks with left date**********

Dim ColDDEmpCode As Long
ColDDEmpCode = Worksheets("DATABASE").Range("1:1").Find("*EMP*ID*").Column
'MsgBox "Emp Code Col No " & ColDDEmpCode

Dim ColDDRemarks As Long
ColDDRemarks = Worksheets("DATABASE").Range("1:1").Find("*Remark*").Column
'MsgBox "Remarks " & ColDDRemarks

Dim DDEmpCode As String
Dim DDRemarks As String

leftcurrrecord = leftcurrrecord + 1
Loop Until leftcurrrecord > recordcount

End Sub

Some videos you may like

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"

Watch MrExcel Video

Forum statistics

Latest member

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
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 "".
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