Change column values depending upon the selection

H

Hasan

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"

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

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 here:" & 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


xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx


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
 
J

Joel

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 here:" & 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
 
H

Hasan

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 here:" & 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





















- Show quoted text -
Click to expand...

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
 
H

Hasan

- Show quoted text -...

read more »
Click to expand...

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 ?
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Code to delete names works in one WB, but not another WB? 2
Match style 0
VBA Export to PDF 0
Making a macro only work on certain files 2
Remove Identical words 0
Automatically Check Each Worksheet For Duplicate Entry 40
VBA-Table Word 2019 - Move a selected text, from a cell to the adjacent cell to its right, by pressing the ENTER key 0
how to have 2 drop down lists filter rows 2

Top