Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Sum values in a column depending on start time in another column | New Users to Excel | |||
change controlsource for textbox depending on combobox selection | Excel Programming | |||
Change InputBox Range Selection to Column Letter Selection | Excel Programming | |||
Sum values depending in values next column | Excel Discussion (Misc queries) | |||
Change from Column Selection to Cell Selection | Excel Programming |