ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Change column values depending upon the selection (https://www.excelbanter.com/excel-programming/434805-change-column-values-depending-upon-selection.html)

Hasan[_2_]

Change column values depending upon the selection
 
Hi,

Functionality of below macro :

Search for the selected value from the data validation list(from
Sheet3 Column A) in the entire workbook(except Sheet3) and if found
then

1. Shows message "Value already exists in sheet" and select that cell
where the value exists

2. Checks for its corresponding values in Sheet3 column B. Say if its
apple then shows message "this is be on apple sheet"

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxx

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
Dim wsLoop As Worksheet
Dim FoundCell As Range
Dim myAddr As String
Dim TopRng As Range
Dim BotRng As Range
Dim BigRng As Range
Dim LastRow As Long
Dim FirstRow As Long
Dim res As Variant


myAddr = "A2:A2000"
With Sh.Range(myAddr)
FirstRow = .Row
LastRow = .Rows(.Rows.Count).Row
End With


If Intersect(Target, Sh.Range(myAddr)) Is Nothing Then
Exit Sub
End If


If Target.Cells.Count 1 Then
Exit Sub 'single cell at a time
End If

If Target.Value = "" Then
'do nothing
Else
For Each wsLoop In ThisWorkbook.Worksheets
Select Case LCase(wsLoop.Name)
Case Is = LCase("Sheet3")
'skip it
Case Else
Set BigRng = wsLoop.Range(myAddr)
If LCase(wsLoop.Name) = LCase(Sh.Name) Then
With BigRng
If Target.Row = FirstRow Then
'in row 2, don't include it
Set BigRng = .Resize(.Rows.Count -
1).Offset(1, 0)
Else
If Target.Row = LastRow Then
'in row 200, don't include it
Set BigRng = .Resize(.Rows.Count - 1)
Else
Set TopRng = wsLoop.Range("A" &
FirstRow _
& ":A" & Target.Row -
1)
Set BotRng = wsLoop.Range("A" &
Target.Row + 1 _
& ":A" & LastRow)
Set BigRng = Union(TopRng, BotRng)
End If
End If
End With
End If


With BigRng
Set FoundCell = .Cells.Find(what:=Target.Value, _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows,
_

SearchDirection:=xlNext, _
MatchCase:=False)
End With


If FoundCell Is Nothing Then
'not found
Else
MsgBox "That entry already exists he" & vbLf _
& FoundCell.Address(external:=True)
Application.EnableEvents = False
Target.ClearContents
Application.Goto FoundCell, Scroll:=True 'or
false??
Application.EnableEvents = True
Exit For
End If
End Select
Next wsLoop



res _
= Application.VLookup(Target.Value, Worksheets("Sheet3").Range
("A:R"), 18, False)
If IsError(res) Then
'no message
Else
If LCase(Sh.Name) = LCase(res) Then
'do nothing
Else
MsgBox Target.Value & " should be on " & res
Application.EnableEvents = False
Target.Value = ""
Application.EnableEvents = True


End If
End If


End If


End Sub


xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xxxxxx


Requirement :

Depending upon the selection, i want the other columns(says C,D,E) in
the sheet to display sheet3 column(say D,G,H) values

joel

Change column values depending upon the selection
 
See if this helps. I used the VBA find instead of the worksheet function
VLookup.

Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Target As Range)
Dim wsLoop As Worksheet
Dim FoundCell As Range
Dim myAddr As String
Dim TopRng As Range
Dim BotRng As Range
Dim BigRng As Range
Dim LastRow As Long
Dim FirstRow As Long
Dim res As Variant



myAddr = "A2:A2000"
With Sh.Range(myAddr)
FirstRow = .Row
LastRow = .Rows(.Rows.Count).Row
End With


If Intersect(Target, Sh.Range(myAddr)) Is Nothing Then
Exit Sub
End If


If Target.Cells.Count 1 Then
Exit Sub 'single cell at a time
End If

Application.EnableEvents = False


If Target.Value = "" Then
'do nothing
Else
For Each wsLoop In ThisWorkbook.Worksheets
Select Case LCase(wsLoop.Name)
Case Is = LCase("Sheet3")
'skip it
Case Else
Set BigRng = wsLoop.Range(myAddr)
If LCase(wsLoop.Name) = LCase(Sh.Name) Then
With BigRng
If Target.Row = FirstRow Then
'in row 2, don't include it
Set BigRng = _
.Resize(.Rows.Count - 1).Offset(1, 0)
Else
If Target.Row = LastRow Then
'in row 200, don't include it
Set BigRng = .Resize(.Rows.Count - 1)
Else
Set TopRng = _
wsLoop.Range("A" & FirstRow & _
":A" & Target.Row - 1)
Set BotRng = _
wsLoop.Range("A" & Target.Row + 1 & _
":A" & LastRow)
Set BigRng = Union(TopRng, BotRng)
End If
End If
End With
End If


With BigRng
Set FoundCell = .Find(What:=Target.Value, _
After:=.Cells(1), _
LookIn:=xlValues, _
lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
End With


If FoundCell Is Nothing Then
'not found
Else
MsgBox "That entry already exists he" & vbLf _
& FoundCell.Address(external:=True)
Application.EnableEvents = False
Target.ClearContents

With Worksheets("Sheet3")
Set c = .Range("A").Find(What:=Target, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
'no message
Else
res = LCase(.Range("R" & c.Row))
If LCase(Sh.Name) = res Then
'do nothing
Else
MsgBox Target.Value & " should be on " & res
Col_D = LCase(.Range("D" & c.Row))
Col_G = LCase(.Range("G" & c.Row))
Col_F = LCase(.Range("F" & c.Row))
With wsLoop
.Range("C" & FoundCell.Row) = Col_D
.Range("D" & FoundCell.Row) = Col_G
.Range("E" & FoundCell.Row) = Col_F
End With
End If

Exit For
End If
End With
End If
End Select
Next wsLoop
End If

Application.EnableEvents = True

End Sub




"Hasan" wrote:

Hi,

Functionality of below macro :

Search for the selected value from the data validation list(from
Sheet3 Column A) in the entire workbook(except Sheet3) and if found
then

1. Shows message "Value already exists in sheet" and select that cell
where the value exists

2. Checks for its corresponding values in Sheet3 column B. Say if its
apple then shows message "this is be on apple sheet"

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxx

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
Dim wsLoop As Worksheet
Dim FoundCell As Range
Dim myAddr As String
Dim TopRng As Range
Dim BotRng As Range
Dim BigRng As Range
Dim LastRow As Long
Dim FirstRow As Long
Dim res As Variant


myAddr = "A2:A2000"
With Sh.Range(myAddr)
FirstRow = .Row
LastRow = .Rows(.Rows.Count).Row
End With


If Intersect(Target, Sh.Range(myAddr)) Is Nothing Then
Exit Sub
End If


If Target.Cells.Count 1 Then
Exit Sub 'single cell at a time
End If

If Target.Value = "" Then
'do nothing
Else
For Each wsLoop In ThisWorkbook.Worksheets
Select Case LCase(wsLoop.Name)
Case Is = LCase("Sheet3")
'skip it
Case Else
Set BigRng = wsLoop.Range(myAddr)
If LCase(wsLoop.Name) = LCase(Sh.Name) Then
With BigRng
If Target.Row = FirstRow Then
'in row 2, don't include it
Set BigRng = .Resize(.Rows.Count -
1).Offset(1, 0)
Else
If Target.Row = LastRow Then
'in row 200, don't include it
Set BigRng = .Resize(.Rows.Count - 1)
Else
Set TopRng = wsLoop.Range("A" &
FirstRow _
& ":A" & Target.Row -
1)
Set BotRng = wsLoop.Range("A" &
Target.Row + 1 _
& ":A" & LastRow)
Set BigRng = Union(TopRng, BotRng)
End If
End If
End With
End If


With BigRng
Set FoundCell = .Cells.Find(what:=Target.Value, _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows,
_

SearchDirection:=xlNext, _
MatchCase:=False)
End With


If FoundCell Is Nothing Then
'not found
Else
MsgBox "That entry already exists he" & vbLf _
& FoundCell.Address(external:=True)
Application.EnableEvents = False
Target.ClearContents
Application.Goto FoundCell, Scroll:=True 'or
false??
Application.EnableEvents = True
Exit For
End If
End Select
Next wsLoop



res _
= Application.VLookup(Target.Value, Worksheets("Sheet3").Range
("A:R"), 18, False)
If IsError(res) Then
'no message
Else
If LCase(Sh.Name) = LCase(res) Then
'do nothing
Else
MsgBox Target.Value & " should be on " & res
Application.EnableEvents = False
Target.Value = ""
Application.EnableEvents = True


End If
End If


End If


End Sub


xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xxxxxx


Requirement :

Depending upon the selection, i want the other columns(says C,D,E) in
the sheet to display sheet3 column(say D,G,H) values


zhangliang

Change column values depending upon the selection
 

The Priority buyout is an extension from the basic WOW DKP out of the
second system.

WOW DKP is also called dragon kill point, which is a number of
activities that you participate in the team to quantify how much
contribution to the union. WOW DKP points only for the purchase the
variety types of group activities with falling epic equipment, props and
the task rare items. DKP are considered as the private property,
prohibiting unauthorized transfer, sale, and modify.

Priority buyout is an extension from the basic WOW DKP out of the
second system. The player might run into this problem, for example, a
new arrival union, the results of previous WOW raid come out to be a
very good weapon, the other person has the same job is not just a lot of
WOW DKP to buy it. Some president will adopt the human policy, they
require newcomers to give up weapons, or simply job captain assigned
directly to the elderly.

In fact, when we accumulated WOW DKP for each additional one hundred
times, we can give the member a priority right to buy out. It is similar
to the tractor inside the main card, as long as it comes out, you can
get rid of other sub-license. In other words, if you offer to use the
priority, then more than any other bid, unless other people also use the
priority to add up WOW DKP.

In this case, action house actually gives us a lot of fun. Because we
accumulated WOW DKP 100, the people have a few priorities in the crash
of the process, which will be destroyed. Our trade unions are saying
"the people have not been waste of the priority, they life is
incomplete." In this way, for a new player, they should work honestly in
the first month to cumulative WOW DKP100, and then they can enter into
the good equipment, or may be involved in the competition. However,
thanks to the credibility of the restrictions, even the WOW SH is not
necessarily to achieve.

Many players like to buy 'WOW gold' (http://www.storeingame.com) from
the 'WOW Gold, Cheap WOW Gold, Buy WOW Gold - StoreInGame'
(http://www.storeingame.com)


--
zhangliang
------------------------------------------------------------------------
zhangliang's Profile: http://www.thecodecage.com/forumz/me...hp?userid=1026
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=143023


Hasan[_2_]

Change column values depending upon the selection
 
On Oct 10, 12:40*pm, Joel wrote:
See if this helps. *I used the VBA find instead of the worksheet function
VLookup.

Private Sub Workbook_SheetChange(ByVal Sh As Object, _
* *ByVal Target As Range)
* * Dim wsLoop As Worksheet
* * Dim FoundCell As Range
* * Dim myAddr As String
* * Dim TopRng As Range
* * Dim BotRng As Range
* * Dim BigRng As Range
* * Dim LastRow As Long
* * Dim FirstRow As Long
* * Dim res As Variant

* * myAddr = "A2:A2000"
* * With Sh.Range(myAddr)
* * * * FirstRow = .Row
* * * * LastRow = .Rows(.Rows.Count).Row
* * End With

* * If Intersect(Target, Sh.Range(myAddr)) Is Nothing Then
* * * * Exit Sub
* * End If

* * If Target.Cells.Count 1 Then
* * * * Exit Sub 'single cell at a time
* * End If

Application.EnableEvents = False

If Target.Value = "" Then
'do nothing
Else
* * For Each wsLoop In ThisWorkbook.Worksheets
* * * * Select Case LCase(wsLoop.Name)
* * * * * * Case Is = LCase("Sheet3")
* * * * * * * * 'skip it
* * * * * * Case Else
* * * * * * * * Set BigRng = wsLoop.Range(myAddr)
* * * * * * * * If LCase(wsLoop.Name) = LCase(Sh.Name) Then
* * * * * * * * * * With BigRng
* * * * * * * * * * * * If Target.Row = FirstRow Then
* * * * * * * * * * * * * * 'in row 2, don't include it
* * * * * * * * * * * * * * Set BigRng = _
* * * * * * * * * * * * * * * *.Resize(.Rows.Count - 1).Offset(1, 0)
* * * * * * * * * * * * Else
* * * * * * * * * * * * * * If Target.Row = LastRow Then
* * * * * * * * * * * * * * * * 'in row 200, don't include it
* * * * * * * * * * * * * * * * Set BigRng = .Resize(.Rows.Count - 1)
* * * * * * * * * * * * * * Else
* * * * * * * * * * * * * * * * Set TopRng = _
* * * * * * * * * * * * * * * * * *wsLoop.Range("A" & FirstRow & _
* * * * * * * * * * * * * * * * * * * ":A" & Target.Row - 1)
* * * * * * * * * * * * * * * * Set BotRng = _
* * * * * * * * * * * * * * * * * *wsLoop.Range("A" & Target.Row + 1 & _
* * * * * * * * * * * * * * * * * * * ":A" & LastRow)
* * * * * * * * * * * * * * * * Set BigRng = Union(TopRng, BotRng)
* * * * * * * * * * * * * * End If
* * * * * * * * * * * * End If
* * * * * * * * * * End With
* * * * * * * * End If

* * * * * * * * With BigRng
* * * * * * * * * * Set FoundCell = .Find(What:=Target.Value, _
* * * * * * * * * * * * * * * * * * * *After:=.Cells(1), _
* * * * * * * * * * * * * * * * * * * *LookIn:=xlValues, _
* * * * * * * * * * * * * * * * * * * *lookat:=xlWhole, _
* * * * * * * * * * * * * * * * * * * *SearchOrder:=xlByRows, _
* * * * * * * * * * * * * * * * * * * *SearchDirection:=xlNext, _
* * * * * * * * * * * * * * * * * * * *MatchCase:=False)
* * * * * * * * End With

* * * * * * * * If FoundCell Is Nothing Then
* * * * * * * * * * 'not found
* * * * * * * * Else
* * * * * * * * * *MsgBox "That entry already exists he" & vbLf _
* * * * * * * * * * * *& FoundCell.Address(external:=True)
* * * * * * * * * *Application.EnableEvents = False
* * * * * * * * * *Target.ClearContents

* * * * * * * * * *With Worksheets("Sheet3")
* * * * * * * * * * * Set c = .Range("A").Find(What:=Target, _
* * * * * * * * * * * * *LookIn:=xlValues, lookat:=xlWhole)
* * * * * * * * * * * If c Is Nothing Then
* * * * * * * * * * * * *'no message
* * * * * * * * * * * Else
* * * * * * * * * * * * *res = LCase(.Range("R" & c.Row))
* * * * * * * * * * * * *If LCase(Sh.Name) = res Then
* * * * * * * * * * * * * * 'do nothing
* * * * * * * * * * * * *Else
* * * * * * * * * * * * * * MsgBox Target.Value & " should be on " & res
* * * * * * * * * * * * * * Col_D = LCase(.Range("D" & c.Row))
* * * * * * * * * * * * * * Col_G = LCase(.Range("G" & c.Row))
* * * * * * * * * * * * * * Col_F = LCase(.Range("F" & c.Row))
* * * * * * * * * * * * * * With wsLoop
* * * * * * * * * * * * * * * * .Range("C" & FoundCell.Row) = Col_D
* * * * * * * * * * * * * * * * .Range("D" & FoundCell.Row) = Col_G
* * * * * * * * * * * * * * * * .Range("E" & FoundCell.Row) = Col_F
* * * * * * * * * * * * * * *End With
* * * * * * * * * * * * * End If

* * * * * * * * * * * * * Exit For
* * * * * * * * * * *End If
* * * * * * * * * End With
* * * * * * * *End If
* * * * End Select
* * Next wsLoop
End If

Application.EnableEvents = True

End Sub



"Hasan" wrote:
Hi,


Functionality of below macro :


Search for the selected value from the data validation list(from
Sheet3 Column A) in the entire workbook(except Sheet3) and if found
then


1. Shows message "Value already exists in sheet" and select that cell
where the value exists


2. Checks for its corresponding values in Sheet3 column B. Say if its
apple then shows message "this is be on apple sheet"


xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxx


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
* * Dim wsLoop As Worksheet
* * Dim FoundCell As Range
* * Dim myAddr As String
* * Dim TopRng As Range
* * Dim BotRng As Range
* * Dim BigRng As Range
* * Dim LastRow As Long
* * Dim FirstRow As Long
* * Dim res As Variant


* * myAddr = "A2:A2000"
* * With Sh.Range(myAddr)
* * * * FirstRow = .Row
* * * * LastRow = .Rows(.Rows.Count).Row
* * End With


* * If Intersect(Target, Sh.Range(myAddr)) Is Nothing Then
* * * * Exit Sub
* * End If


* * If Target.Cells.Count 1 Then
* * * * Exit Sub 'single cell at a time
* * End If


If Target.Value = "" Then
'do nothing
Else
* * For Each wsLoop In ThisWorkbook.Worksheets
* * * * Select Case LCase(wsLoop.Name)
* * * * * * Case Is = LCase("Sheet3")
* * * * * * * * 'skip it
* * * * * * Case Else
* * * * * * * * Set BigRng = wsLoop.Range(myAddr)
* * * * * * * * If LCase(wsLoop.Name) = LCase(Sh.Name) Then
* * * * * * * * * * With BigRng
* * * * * * * * * * * * If Target.Row = FirstRow Then
* * * * * * * * * * * * * * 'in row 2, don't include it
* * * * * * * * * * * * * * Set BigRng = ..Resize(.Rows.Count -
1).Offset(1, 0)
* * * * * * * * * * * * Else
* * * * * * * * * * * * * * If Target.Row = LastRow Then
* * * * * * * * * * * * * * * * 'in row 200, don't include it
* * * * * * * * * * * * * * * * Set BigRng = .Resize(.Rows.Count - 1)
* * * * * * * * * * * * * * Else
* * * * * * * * * * * * * * * * Set TopRng = wsLoop.Range("A" &
FirstRow _
* * * * * * * * * * * * * * * * * * * * * * * * & ":A" & Target.Row -
1)
* * * * * * * * * * * * * * * * Set BotRng = wsLoop.Range("A" &
Target.Row + 1 _
* * * * * * * * * * * * * * * * * * * * * * * * & ":A" & LastRow)
* * * * * * * * * * * * * * * * Set BigRng = Union(TopRng, BotRng)
* * * * * * * * * * * * * * End If
* * * * * * * * * * * * End If
* * * * * * * * * * End With
* * * * * * * * End If


* * * * * * * * With BigRng
* * * * * * * * * * Set FoundCell = .Cells.Find(what:=Target.Value, _
* * * * * * * * * * * * * * * * * * * * * * * * After:=.Cells(1), _
* * * * * * * * * * * * * * * * * * * * * * * * LookIn:=xlValues, _
* * * * * * * * * * * * * * * * * * * * * * * * LookAt:=xlWhole, _
* * * * * * * * * * * * * * * * * * * * * * * * SearchOrder:=xlByRows,
_


SearchDirection:=xlNext, _
* * * * * * * * * * * * * * * * * * * * * * * * MatchCase:=False)
* * * * * * * * End With


* * * * * * * * If FoundCell Is Nothing Then
* * * * * * * * * * 'not found
* * * * * * * * Else
* * * * * * * * * * *MsgBox "That entry already exists he" & vbLf _
* * * * * * * * * * * * & FoundCell.Address(external:=True)
* * * * * * * * * * Application.EnableEvents = False
* * * * * * * * * * Target.ClearContents
* * * * * * * * * * Application.Goto FoundCell, Scroll:=True 'or
false??
* * * * * * * * * * Application.EnableEvents = True
* * * * * * * * * * Exit For
* * * * * * * * End If
* * * * End Select
* * Next wsLoop


* * * res _
*= Application.VLookup(Target.Value, Worksheets("Sheet3").Range
("A:R"), 18, False)
If IsError(res) Then
* 'no message
Else
* *If LCase(Sh.Name) = LCase(res) Then
* * * *'do nothing
* *Else
* * * MsgBox Target.Value & " should be on " & res
* * * Application.EnableEvents = False
Target.Value = ""
Application.EnableEvents = True


* *End If
End If


End If


End Sub


xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xxxxxx


Requirement :


Depending upon the selection, i want the other columns(says C,D,E) in
the sheet to display sheet3 column(say D,G,H) values- Hide quoted text -


- Show quoted text -


Its not working the way i wanted.

Depending upon the selection from the data validation list in column
A, i want the macro to validate with the sheet3 column A values and if
it matches then change the other columns(says C,D,E) in the sheet with
its correspoding values in sheet3 column(say D,G,H) values

Hasan[_2_]

Change column values depending upon the selection
 
On Oct 13, 1:26*am, Hasan wrote:
On Oct 10, 12:40*pm, Joel wrote:



See if this helps. *I used the VBA find instead of the worksheet function
VLookup.


Private Sub Workbook_SheetChange(ByVal Sh As Object, _
* *ByVal Target As Range)
* * Dim wsLoop As Worksheet
* * Dim FoundCell As Range
* * Dim myAddr As String
* * Dim TopRng As Range
* * Dim BotRng As Range
* * Dim BigRng As Range
* * Dim LastRow As Long
* * Dim FirstRow As Long
* * Dim res As Variant


* * myAddr = "A2:A2000"
* * With Sh.Range(myAddr)
* * * * FirstRow = .Row
* * * * LastRow = .Rows(.Rows.Count).Row
* * End With


* * If Intersect(Target, Sh.Range(myAddr)) Is Nothing Then
* * * * Exit Sub
* * End If


* * If Target.Cells.Count 1 Then
* * * * Exit Sub 'single cell at a time
* * End If


Application.EnableEvents = False


If Target.Value = "" Then
'do nothing
Else
* * For Each wsLoop In ThisWorkbook.Worksheets
* * * * Select Case LCase(wsLoop.Name)
* * * * * * Case Is = LCase("Sheet3")
* * * * * * * * 'skip it
* * * * * * Case Else
* * * * * * * * Set BigRng = wsLoop.Range(myAddr)
* * * * * * * * If LCase(wsLoop.Name) = LCase(Sh.Name) Then
* * * * * * * * * * With BigRng
* * * * * * * * * * * * If Target.Row = FirstRow Then
* * * * * * * * * * * * * * 'in row 2, don't include it
* * * * * * * * * * * * * * Set BigRng = _
* * * * * * * * * * * * * * * *.Resize(..Rows.Count - 1).Offset(1, 0)
* * * * * * * * * * * * Else
* * * * * * * * * * * * * * If Target.Row = LastRow Then
* * * * * * * * * * * * * * * * 'in row 200, don't include it
* * * * * * * * * * * * * * * * Set BigRng = .Resize(.Rows.Count - 1)
* * * * * * * * * * * * * * Else
* * * * * * * * * * * * * * * * Set TopRng = _
* * * * * * * * * * * * * * * * * *wsLoop.Range("A" & FirstRow & _
* * * * * * * * * * * * * * * * * * * ":A" & Target.Row - 1)
* * * * * * * * * * * * * * * * Set BotRng = _
* * * * * * * * * * * * * * * * * *wsLoop.Range("A" & Target.Row + 1 & _
* * * * * * * * * * * * * * * * * * * ":A" & LastRow)
* * * * * * * * * * * * * * * * Set BigRng = Union(TopRng, BotRng)
* * * * * * * * * * * * * * End If
* * * * * * * * * * * * End If
* * * * * * * * * * End With
* * * * * * * * End If


* * * * * * * * With BigRng
* * * * * * * * * * Set FoundCell = .Find(What:=Target.Value, _
* * * * * * * * * * * * * * * * * * * *After:=.Cells(1), _
* * * * * * * * * * * * * * * * * * * *LookIn:=xlValues, _
* * * * * * * * * * * * * * * * * * * *lookat:=xlWhole, _
* * * * * * * * * * * * * * * * * * * *SearchOrder:=xlByRows, _
* * * * * * * * * * * * * * * * * * * *SearchDirection:=xlNext, _
* * * * * * * * * * * * * * * * * * * *MatchCase:=False)
* * * * * * * * End With


* * * * * * * * If FoundCell Is Nothing Then
* * * * * * * * * * 'not found
* * * * * * * * Else
* * * * * * * * * *MsgBox "That entry already exists he" & vbLf _
* * * * * * * * * * * *& FoundCell.Address(external:=True)
* * * * * * * * * *Application.EnableEvents = False
* * * * * * * * * *Target.ClearContents


* * * * * * * * * *With Worksheets("Sheet3")
* * * * * * * * * * * Set c = .Range("A").Find(What:=Target, _
* * * * * * * * * * * * *LookIn:=xlValues, lookat:=xlWhole)
* * * * * * * * * * * If c Is Nothing Then
* * * * * * * * * * * * *'no message
* * * * * * * * * * * Else
* * * * * * * * * * * * *res = LCase(.Range("R" & c.Row))
* * * * * * * * * * * * *If LCase(Sh.Name) = res Then
* * * * * * * * * * * * * * 'do nothing
* * * * * * * * * * * * *Else
* * * * * * * * * * * * * * MsgBox Target.Value & " should be on " & res
* * * * * * * * * * * * * * Col_D = LCase(.Range("D" & c.Row))
* * * * * * * * * * * * * * Col_G = LCase(.Range("G" & c.Row))
* * * * * * * * * * * * * * Col_F = LCase(.Range("F" & c.Row))
* * * * * * * * * * * * * * With wsLoop
* * * * * * * * * * * * * * * * .Range("C" & FoundCell.Row) = Col_D
* * * * * * * * * * * * * * * * .Range("D" & FoundCell.Row) = Col_G
* * * * * * * * * * * * * * * * .Range("E" & FoundCell.Row) = Col_F
* * * * * * * * * * * * * * *End With
* * * * * * * * * * * * * End If


* * * * * * * * * * * * * Exit For
* * * * * * * * * * *End If
* * * * * * * * * End With
* * * * * * * *End If
* * * * End Select
* * Next wsLoop
End If


Application.EnableEvents = True


End Sub


"Hasan" wrote:
Hi,


Functionality of below macro :


Search for the selected value from the data validation list(from
Sheet3ColumnA) in the entire workbook(except Sheet3) and if found
then


1. Shows message "Value already exists in sheet" and select that cell
where the value exists


2. Checks for its correspondingvaluesin Sheet3columnB. Say if its
apple then shows message "this is be on apple sheet"


xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxx


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
* * Dim wsLoop As Worksheet
* * Dim FoundCell As Range
* * Dim myAddr As String
* * Dim TopRng As Range
* * Dim BotRng As Range
* * Dim BigRng As Range
* * Dim LastRow As Long
* * Dim FirstRow As Long
* * Dim res As Variant


* * myAddr = "A2:A2000"
* * With Sh.Range(myAddr)
* * * * FirstRow = .Row
* * * * LastRow = .Rows(.Rows.Count).Row
* * End With


* * If Intersect(Target, Sh.Range(myAddr)) Is Nothing Then
* * * * Exit Sub
* * End If


* * If Target.Cells.Count 1 Then
* * * * Exit Sub 'single cell at a time
* * End If


If Target.Value = "" Then
'do nothing
Else
* * For Each wsLoop In ThisWorkbook.Worksheets
* * * * Select Case LCase(wsLoop.Name)
* * * * * * Case Is = LCase("Sheet3")
* * * * * * * * 'skip it
* * * * * * Case Else
* * * * * * * * Set BigRng = wsLoop.Range(myAddr)
* * * * * * * * If LCase(wsLoop.Name) = LCase(Sh.Name) Then
* * * * * * * * * * With BigRng
* * * * * * * * * * * * If Target.Row = FirstRow Then
* * * * * * * * * * * * * * 'in row 2, don't include it
* * * * * * * * * * * * * * Set BigRng = .Resize(.Rows.Count -
1).Offset(1, 0)
* * * * * * * * * * * * Else
* * * * * * * * * * * * * * If Target.Row = LastRow Then
* * * * * * * * * * * * * * * * 'in row 200, don't include it
* * * * * * * * * * * * * * * * Set BigRng = .Resize(.Rows.Count - 1)
* * * * * * * * * * * * * * Else
* * * * * * * * * * * * * * * * Set TopRng = wsLoop.Range("A" &
FirstRow _
* * * * * * * * * * * * * * * * * * * * * * * * & ":A" & Target.Row -
1)
* * * * * * * * * * * * * * * * Set BotRng = wsLoop.Range("A" &
Target.Row + 1 _
* * * * * * * * * * * * * * * * * * * * * * * * & ":A" & LastRow)
* * * * * * * * * * * * * * * * Set BigRng = Union(TopRng, BotRng)
* * * * * * * * * * * * * * End If
* * * * * * * * * * * * End If
* * * * * * * * * * End With
* * * * * * * * End If


* * * * * * * * With BigRng
* * * * * * * * * * Set FoundCell = .Cells.Find(what:=Target.Value, _
* * * * * * * * * * * * * * * * * * * * * * * * After:=.Cells(1), _
* * * * * * * * * * * * * * * * * * * * * * * * LookIn:=xlValues, _
* * * * * * * * * * * * * * * * * * * * * * * * LookAt:=xlWhole, _
* * * * * * * * * * * * * * * * * * * * * * * * SearchOrder:=xlByRows,
_


SearchDirection:=xlNext, _
* * * * * * * * * * * * * * * * * * * * * * * * MatchCase:=False)
* * * * * * * * End With


* * * * * * * * If FoundCell Is Nothing Then
* * * * * * * * * * 'not found
* * * * * * * * Else
* * * * * * * * * * *MsgBox "That entry already exists he" & vbLf _
* * * * * * * * * * * * & FoundCell.Address(external:=True)
* * * * * * * * * * Application.EnableEvents = False
* * * * * * * * * * Target.ClearContents
* * * * * * * * * * Application.Goto FoundCell, Scroll:=True 'or
false??
* * * * * * * * * * Application.EnableEvents = True
* * * * * * * * * * Exit For
* * * * * * * * End If
* * * * End Select
* * Next wsLoop


* * * res _
*= Application.VLookup(Target.Value, Worksheets("Sheet3").Range
("A:R"), 18, False)
If IsError(res) Then
* 'no message
Else
* *If LCase(Sh.Name) = LCase(res) Then
* * * *'do nothing
* *Else
* * * MsgBox Target.Value & " should- Hide quoted text -


- Show quoted text -...

read more »


How do i vlookup 2 columns(say sheet1 & sheet2 column A) in different
sheet and get it corresponding sheet 2 column D value in sheet 1 ?


All times are GMT +1. The time now is 05:04 AM.

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