Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 32
Default 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
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 9,101
Default 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

  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default 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

  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 32
Default 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
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 32
Default 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 ?
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Sum values in a column depending on start time in another column Morgan New Users to Excel 5 October 26th 09 01:02 AM
change controlsource for textbox depending on combobox selection Maverikk Excel Programming 2 August 31st 09 12:03 AM
Change InputBox Range Selection to Column Letter Selection intoit Excel Programming 2 July 21st 09 07:58 AM
Sum values depending in values next column luiss Excel Discussion (Misc queries) 4 July 7th 06 05:30 AM
Change from Column Selection to Cell Selection Lil Pun[_16_] Excel Programming 4 June 16th 06 10:38 PM


All times are GMT +1. The time now is 07:18 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"