ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Find Matching Cell and Copy Cell Content in same Row (https://www.excelbanter.com/excel-programming/389410-find-matching-cell-copy-cell-content-same-row.html)

ricowyder

Find Matching Cell and Copy Cell Content in same Row
 
Dear users,

I've been working on this quite a while, but was not successful. Maybe
you find the mistake or you know how it can be done better.

I have worksheet A and B. Its like a database: A is reporting (special
filter), B contains all Data. That said, my colleagues want to change
content in A and not B (due to complexity). Since the filter only
works one way, I would like to have a macro "copy me" - me is
reffering to one cell. Whenever they change a cell, the do a short cut
afterwards, e.g. ctrl + f then Sub CopyMe () runs:

1. Identify Cell in A (row and column) -- save
2. In A go to Column 1 and check value of that cell (Number that
identifies the Record Number in database)
3. Go to B and find Record Number in Column 1
4. If found, on same row go to stored Column Number and paste special
content from A.Cell.

Here is my code, please let me know how I can make it run... this
would be great.

Sub CopyMe()

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

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

ActiveSheet.Cells(x, y).Copy

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

End Sub


Dave Peterson

Find Matching Cell and Copy Cell Content in same Row
 
First, I'd change to this line (.cells, not .range):

Worksheets("A").Cells(fRng.Row, y).PasteSpecial Paste:=xlValues

====
You may want to rearrange your sequence, too:

If Not fRng Is Nothing Then
ActiveSheet.Cells(x, y).Copy
Worksheets("A").Range(fRng.Row, y).PasteSpecial Paste:=xlValues
application.cutcopymode = false 'remove the dancing ants/marquee
End If

There are things that can cause the clipboard's contents to be lost. By putting
them right together, you can avoid a few problems--but your code did work ok for
me without this change.

And you may want to specify all the options--not just the ones you think you
need--in your .find statement.

Excel and VBA will use whatever the last .find (manual or in code) used. So you
may be hoping that you're looking at xlwhole, but you may not be. It depends on
that last .find.



ricowyder wrote:

Dear users,

I've been working on this quite a while, but was not successful. Maybe
you find the mistake or you know how it can be done better.

I have worksheet A and B. Its like a database: A is reporting (special
filter), B contains all Data. That said, my colleagues want to change
content in A and not B (due to complexity). Since the filter only
works one way, I would like to have a macro "copy me" - me is
reffering to one cell. Whenever they change a cell, the do a short cut
afterwards, e.g. ctrl + f then Sub CopyMe () runs:

1. Identify Cell in A (row and column) -- save
2. In A go to Column 1 and check value of that cell (Number that
identifies the Record Number in database)
3. Go to B and find Record Number in Column 1
4. If found, on same row go to stored Column Number and paste special
content from A.Cell.

Here is my code, please let me know how I can make it run... this
would be great.

Sub CopyMe()

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

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

ActiveSheet.Cells(x, y).Copy

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

End Sub


--

Dave Peterson


All times are GMT +1. The time now is 09:56 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com