find matching cell in spread over two worksheets

[ricowyder]

Dear users,

My workbook contains two worksheets. One is my "database", the other
one is a sheet in which I filter my database (special filter).

Each row in my database is a special case with several cells of
information.

My colleagues will be using the filter to find specific cases filtered
by different criterias. Therefore, the result will always be a
different amount of rows.

To their comfort, I would like to offer them the possibility to change
the cell value right in the filter.

Each "case", when it is created, has in column "A" a case-number. This
number might not be identical with the row number.

My idea is the following:

I would like to offer a sub, which can be started by a Shortcut (I can
handle that, I guess). The Sub should do then the following:

- ActiveWorksheet: ActiveCell find out Column XYZ, find out Case-
Number on the same row in Column A
- In other Worksheet: Find matching Case-Number, in the same row, go
to Column XYZ (as in ActiveWorksheet) and copy Copy Value of
ActiveCell into this cell

Thanks a lot for your help.

If you can also help me to restrict the short-cut to work only in a
specific area like Worksheets("Name").Range("A8:AA1000"), I would be
very thankful.

Thank you very much to anybody who contributes to this post.

Sincerely,

Rico

 

[Guest]

I took some liberties with the sheet names. You can change them to the
actual names or index numbers as applicable. I did not set up a test so if
you make this into a macro, be sure to test it on a copy before installing in
your original documents.

Dim x, y As Long
Dim myVar As Variant, fRng As String

With ActiveSheet
Set x = ActiveCell.Row
Set y = ActiveCell.Column
myVar = Cells(x, 1).Value
End With
With Worksheets("Database").Range("A2:A" & Cells(Rows.Count, 1).End(xlUP).Row)
Set c = .Find(myVar, LookIn:=xlValues)
If Not c Is Nothing Then
fRng = c.Address
.Cells(Range(fRng.Row, y).Copy Worksheets("Special Filters").Cells(x, y)
End If
End With

 

[ricowyder]

I took some liberties with the sheet names. You can change them to the
actual names or index numbers as applicable. I did not set up a test so if
you make this into a macro, be sure to test it on a copy before installing in
your original documents.

Dim x, y As Long
Dim myVar As Variant, fRng As String

With ActiveSheet
Set x = ActiveCell.Row
Set y = ActiveCell.Column
myVar = Cells(x, 1).Value
End With
With Worksheets("Database").Range("A2:A" & Cells(Rows.Count, 1).End(xlUP).Row)
Set c = .Find(myVar, LookIn:=xlValues)
If Not c Is Nothing Then
fRng = c.Address
.Cells(Range(fRng.Row, y).Copy Worksheets("Special Filters").Cells(x, y)
End If
End With
















- Show quoted text -

Thanks a lot! Unfortunately, it does give an error message at .Row or
at y or at .Column
--> message: "object required"
I tried different things, but was not successful. Can anybody assist?
I made some configurations. Here is my current code:

Sub CopyMe()

Dim x, y As Long
Dim myVar As Variant, fRng As String

With ActiveSheet
Set x = ActiveCell.Row
Set y = ActiveCell.Column
myVar = Cells(x, 1).Value
End With

ActiveSheet.Cells(x, y).Copy

With Worksheets("Dbase").Range("A2:A" & Cells(Rows.Count,
1).End(xlUp).Row)
Set c = .Find(myVar, LookIn:=xlValues)
If Not c Is Nothing Then
fRng = c.Address
Worksheets("Dbase").Range(fRng.Row, y).PasteSpecial
Paste:=xlValues
End If
End With

End Sub