ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   tranfering value if... (https://www.excelbanter.com/excel-programming/339469-tranfering-value-if.html)

sal21[_72_]

tranfering value if...
 

If is possible with a macro...
I have 2 sheets Source and Dest.
How can to tranfering the value from the column I an K of sheet Source
in to sheet Dest with this condition:

Note: the colunm A contain the idex from the 2 wbook.

If into column A of sheet Source is present the same value into column
A of sheet Dest copy from Source the value into column I an K and put
into refered cell of column I and K of Dest...
You must know that: Into official wbook the line from the 2 shhet are
approx 35.000 for each sheet


+-------------------------------------------------------------------+
|Filename: INSERT_VALUE.zip |
|Download: http://www.excelforum.com/attachment.php?postid=3789 |
+-------------------------------------------------------------------+

--
sal21


------------------------------------------------------------------------
sal21's Profile: http://www.excelforum.com/member.php...fo&userid=2040
View this thread: http://www.excelforum.com/showthread...hreadid=465827


William Benson[_2_]

tranfering value if...
 
Here is a solution... If you do not like having to select the original range
in Col A, let me know what you would prefer.


Sub CopyIdenticals()
Dim rngSourceCompare As Range
Dim c As Range

On Error Resume Next
Set rngSourceCompare = Application.InputBox(prompt:="Select all cells in col
A for comparison", Type:=8)
If rngSourceCompare Is Nothing Then
Exit Sub
End If

If rngSourceCompare.Parent.Name < "Source" Then
MsgBox "Only choose col A values on sheet 'Source'"
Exit Sub
End If

Application.ScreenUpdating = False
For Each c In rngSourceCompare
If c.Value = Sheets("Dest").Range(c.Address).Value Then
Sheets("Dest").Range("I" & c.Row).Copy Sheets("Source").Range("I" &
c.Row)
Sheets("Dest").Range("K" & c.Row).Copy Sheets("Source").Range("K" &
c.Row)
End If
Next c
Application.ScreenUpdating = True
End Sub

"sal21" wrote in
message ...

If is possible with a macro...
I have 2 sheets Source and Dest.
How can to tranfering the value from the column I an K of sheet Source
in to sheet Dest with this condition:

Note: the colunm A contain the idex from the 2 wbook.

If into column A of sheet Source is present the same value into column
A of sheet Dest copy from Source the value into column I an K and put
into refered cell of column I and K of Dest...
You must know that: Into official wbook the line from the 2 shhet are
approx 35.000 for each sheet


+-------------------------------------------------------------------+
|Filename: INSERT_VALUE.zip |
|Download: http://www.excelforum.com/attachment.php?postid=3789 |
+-------------------------------------------------------------------+

--
sal21


------------------------------------------------------------------------
sal21's Profile:
http://www.excelforum.com/member.php...fo&userid=2040
View this thread: http://www.excelforum.com/showthread...hreadid=465827




William Benson[_2_]

tranfering value if...
 
Sorry, two problems with prior post:

1) I mixed up Source and Dest
2) I copied formulas, not values

Here is the correction:

Sub CopyIdenticals()
Dim rngSourceCompare As Range
Dim c As Range

On Error Resume Next
Set rngSourceCompare = Application.InputBox _
(prompt:="Select all cells in col A for comparison", _
Type:=8)
If rngSourceCompare Is Nothing Then
Exit Sub
End If

If rngSourceCompare.Parent.Name < "Source" Then
MsgBox "Only choose col A values on sheet 'Source'"
Exit Sub
End If

On Error GoTo 0
Application.ScreenUpdating = False
For Each c In rngSourceCompare

If c.Value = Sheets("Dest").Range(c.Address).Value Then
c.Offset(0, 8).Copy 'note: Col I
Sheets("Dest").Range("I" & c.Row).PasteSpecial _
Paste:=xlPasteValues
c.Offset(0, 10).Copy 'note: Col K
Sheets("Dest").Range("K" & c.Row).PasteSpecial _
Paste:=xlPasteValues
End If
Next c
Application.ScreenUpdating = True
End Sub

"William Benson" wrote in message
...
Here is a solution... If you do not like having to select the original
range in Col A, let me know what you would prefer.


Sub CopyIdenticals()
Dim rngSourceCompare As Range
Dim c As Range

On Error Resume Next
Set rngSourceCompare = Application.InputBox(prompt:="Select all cells in
col A for comparison", Type:=8)
If rngSourceCompare Is Nothing Then
Exit Sub
End If

If rngSourceCompare.Parent.Name < "Source" Then
MsgBox "Only choose col A values on sheet 'Source'"
Exit Sub
End If

Application.ScreenUpdating = False
For Each c In rngSourceCompare
If c.Value = Sheets("Dest").Range(c.Address).Value Then
Sheets("Dest").Range("I" & c.Row).Copy Sheets("Source").Range("I" &
c.Row)
Sheets("Dest").Range("K" & c.Row).Copy Sheets("Source").Range("K" &
c.Row)
End If
Next c
Application.ScreenUpdating = True
End Sub

"sal21" wrote in
message ...

If is possible with a macro...
I have 2 sheets Source and Dest.
How can to tranfering the value from the column I an K of sheet Source
in to sheet Dest with this condition:

Note: the colunm A contain the idex from the 2 wbook.

If into column A of sheet Source is present the same value into column
A of sheet Dest copy from Source the value into column I an K and put
into refered cell of column I and K of Dest...
You must know that: Into official wbook the line from the 2 shhet are
approx 35.000 for each sheet


+-------------------------------------------------------------------+
|Filename: INSERT_VALUE.zip |
|Download: http://www.excelforum.com/attachment.php?postid=3789 |
+-------------------------------------------------------------------+

--
sal21


------------------------------------------------------------------------
sal21's Profile:
http://www.excelforum.com/member.php...fo&userid=2040
View this thread:
http://www.excelforum.com/showthread...hreadid=465827






William Benson[_2_]

tranfering value if...
 
Tom Ogilvy gave me a much better, faster solution. Try this: I don't
understand it, but I am going to try harder to understand it!

Sub CopyIdenticals()
Dim rngSourceCompare As Range
Dim rngDest As Range
Dim v1, v2, v1IJK, v2IJK
Dim i As Long
On Error Resume Next
Set rngSourceCompare = Application.InputBox _
(prompt:="Select all cells in col A for comparison", _
Type:=8)
If rngSourceCompare Is Nothing Then
Exit Sub
End If

If rngSourceCompare.Parent.Name < "Source" Then
MsgBox "Only choose col A values on sheet 'Source'"
Exit Sub
End If

On Error GoTo 0
Application.ScreenUpdating = False
v1 = rngSourceCompare.Value
Set rngDest = Worksheets("Dest").Range(rngSourceCompare.Address)
v2 = rngDest.Value
v1IJK = rngSourceCompare.Offset(0, 8).Resize(, 3).Value
v2IJK = rngDest.Offset(0, 8).Resize(, 3).Formula
For i = LBound(v1, 1) To UBound(v1, 1)
If v1(i, 1) = v2(i, 1) Then
v2IJK(i, 1) = v1IJK(i, 1)
v2IJK(i, 3) = v1IJK(i, 3)
End If
Next
rngDest.Offset(0, 8).Resize(, 3).Formula = v2IJK
Application.ScreenUpdating = True
End Sub



"William Benson" wrote in message
...
Sorry, two problems with prior post:

1) I mixed up Source and Dest
2) I copied formulas, not values

Here is the correction:

Sub CopyIdenticals()
Dim rngSourceCompare As Range
Dim c As Range

On Error Resume Next
Set rngSourceCompare = Application.InputBox _
(prompt:="Select all cells in col A for comparison", _
Type:=8)
If rngSourceCompare Is Nothing Then
Exit Sub
End If

If rngSourceCompare.Parent.Name < "Source" Then
MsgBox "Only choose col A values on sheet 'Source'"
Exit Sub
End If

On Error GoTo 0
Application.ScreenUpdating = False
For Each c In rngSourceCompare

If c.Value = Sheets("Dest").Range(c.Address).Value Then
c.Offset(0, 8).Copy 'note: Col I
Sheets("Dest").Range("I" & c.Row).PasteSpecial _
Paste:=xlPasteValues
c.Offset(0, 10).Copy 'note: Col K
Sheets("Dest").Range("K" & c.Row).PasteSpecial _
Paste:=xlPasteValues
End If
Next c
Application.ScreenUpdating = True
End Sub

"William Benson" wrote in message
...
Here is a solution... If you do not like having to select the original
range in Col A, let me know what you would prefer.


Sub CopyIdenticals()
Dim rngSourceCompare As Range
Dim c As Range

On Error Resume Next
Set rngSourceCompare = Application.InputBox(prompt:="Select all cells in
col A for comparison", Type:=8)
If rngSourceCompare Is Nothing Then
Exit Sub
End If

If rngSourceCompare.Parent.Name < "Source" Then
MsgBox "Only choose col A values on sheet 'Source'"
Exit Sub
End If

Application.ScreenUpdating = False
For Each c In rngSourceCompare
If c.Value = Sheets("Dest").Range(c.Address).Value Then
Sheets("Dest").Range("I" & c.Row).Copy Sheets("Source").Range("I"
& c.Row)
Sheets("Dest").Range("K" & c.Row).Copy Sheets("Source").Range("K"
& c.Row)
End If
Next c
Application.ScreenUpdating = True
End Sub

"sal21" wrote in
message ...

If is possible with a macro...
I have 2 sheets Source and Dest.
How can to tranfering the value from the column I an K of sheet Source
in to sheet Dest with this condition:

Note: the colunm A contain the idex from the 2 wbook.

If into column A of sheet Source is present the same value into column
A of sheet Dest copy from Source the value into column I an K and put
into refered cell of column I and K of Dest...
You must know that: Into official wbook the line from the 2 shhet are
approx 35.000 for each sheet


+-------------------------------------------------------------------+
|Filename: INSERT_VALUE.zip |
|Download: http://www.excelforum.com/attachment.php?postid=3789 |
+-------------------------------------------------------------------+

--
sal21


------------------------------------------------------------------------
sal21's Profile:
http://www.excelforum.com/member.php...fo&userid=2040
View this thread:
http://www.excelforum.com/showthread...hreadid=465827









All times are GMT +1. The time now is 12:22 AM.

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