Data Change in array via VB

[asylum]

HI,

I'm after a bit of code to chuck in a macro I have to complete the manipulation of some data I have, but it's a little beyond me, can you help? I've simplified it here, but will upscale to teh couple of thousand rows i have when i implement the solution.

i have on one page a list of data in, say, range a2:c5 this:

01/01/11 RKL
01/02/11 BCL PDB
01/03/11 hgf
01/04/11 BCL

(where dates are dd/mm/yy) i have in a look up range called instdata (range x2:y3) the following:

RKL Jan
BCL Apr

I need to run a script to look at each cell in b2:c5, find it in instdata, and if the month in column a for that line is the same as the month in instdata column 2 to amend the original data by appending "(I)" after it, so after i run the code i am left with:

01/01/11 RKL (I)
01/02/11 BCL PDB
01/03/11 hgf
01/04/11 BCL (I)

Can you help?

Thanks

Andy

 

[venkat1926]

in my region dates in excel are ENTERED as m/d/yy. so I changed column A in sheet1. the data will be like as below.
COPY SHEET 1 TO SHEET 2 (THIS CAN ALSO BE DONE BY RUNNING MACRO "UNDO")

Excel Workbook
	A	B	C
1	date	data2	data3
2	1/1/2011	RKL
3	2/1/2011	BCL	PDB
4	3/1/2011	hgf
5	4/1/2011	BCL
Sheet1

now try this macro "test"(second macro undo is to undo the result)

Sub test()
Dim r As Range, j As Integer, c As Range, k As Integer, cfind As Range
Dim rinst As Range, mm As Integer, dest As Range, x
Dim lastcol As Integer, lastrow As Integer
Dim col As Integer, rrow As Integer
With Worksheets("sheet1")
Set r = .Range("A1").CurrentRegion
'MSGBOX r.Address
lastcol = r.Columns.Count
lastrow = r.Rows.Count
'MSGBOX lastcol
Set r = Range(.Range("B2"), .Cells(lastrow, lastcol))
'MSGBOX r.Address
Set rinst = Range(.Range("X2"), .Range("X2").End(xlDown))
For Each c In r
x = c.Value
rrow = c.Row
col = c.Column
'MSGBOX x
Set cfind = rinst.Cells.Find(what:=c.Value, lookat:=xlWhole)
If Not cfind Is Nothing Then
mm = cfind.Offset(0, 2)
'MSGBOX mm
Else
GoTo nextc
End If
If Month(.Cells(rrow, "A")) = mm Then
With Worksheets("sheet2")
'Set cfind2 = .Cells.Find(what:=x, lookat:=xlWhole)
'cfind2 = cfind2 & "(1)"
.Cells(rrow, col) = .Cells(rrow, col) & "(1)"
End With
End If
nextc:
Next c
End With
End Sub

Sub undo()
Worksheets("sheet2").Cells.Clear
Worksheets("sheet1").Cells.Copy Worksheets("sheet2").Range("A1")
End Sub