Use VB Code for Names through Codes

[arif]

Suppose i have following data

(1) Anu shekh Phone : 7898987
(2) Primer jatin Mo. 878745

I want such a code to be created thr VB that if i press 1 all details of Anu Shekh should be displayed

How to use excel magic

 

[Mike H..]

Suppose i have following data

(1) Anu shekh Phone : 7898987
(2) Primer jatin Mo. 878745

I want such a code to be created thr VB that if i press 1 all details of Anu Shekh should be displayed

How to use excel magic

Hi,

Can you post a workbook with some sample data?

 

[arif]

Hi,

Can you post a workbook with some sample data?

My workbook sample is attached here
its only speciment plz
do needful

 

[Mike H..]

My workbook sample is attached here
its only speciment plz
do needful

Hi,

Have a look at your workbook. The code is this. Change the number in a1 and see the data change.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim TheRow As Long
Dim Lastcol As Long
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
If Target.Address = "$A$1" Then
If IsNumeric(Target) Then
  Application.EnableEvents = False
  On Error Resume Next
  TheRow = Application.Match(Target.Value, Columns(2), 0)
  On Error GoTo 0
  If TheRow > 0 Then
  Lastcol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
  Cells(1, 2).Resize(, Lastcol).ClearContents
  Lastcol = ActiveSheet.Cells(TheRow, Columns.Count).End(xlToLeft).Column
  Cells(TheRow, 2).Resize(, Lastcol - 1).Copy Range("B1")
  End If
  Application.EnableEvents = True
End If
End If
End Sub

 

[arif]

Hi,

Have a look at your workbook. The code is this. Change the number in a1 and see the data change.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim TheRow As Long
Dim Lastcol As Long
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
If Target.Address = "$A$1" Then
If IsNumeric(Target) Then
  Application.EnableEvents = False
  On Error Resume Next
  TheRow = Application.Match(Target.Value, Columns(2), 0)
  On Error GoTo 0
  If TheRow > 0 Then
  Lastcol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
  Cells(1, 2).Resize(, Lastcol).ClearContents
  Lastcol = ActiveSheet.Cells(TheRow, Columns.Count).End(xlToLeft).Column
  Cells(TheRow, 2).Resize(, Lastcol - 1).Copy Range("B1")
  End If
  Application.EnableEvents = True
End If
End If
End Sub

Thanks but if i want to run the VB code in another file what should be typed and where

Consider another workbook also contains the same kind of data plz reply

 

[Mike H..]

Thanks but if i want to run the VB code in another file what should be typed and where

Consider another workbook also contains the same kind of data plz reply

Hi,

See the attached workbook. The workbook name must be in A1 and the record number in A2.

Sub Button1_Click()
Dim wb As Workbook, TheRow As Long
Dim LastCol As Long
Set wb = Workbooks(Sheets("Sheet1").Range("A1").Value)
  On Error Resume Next
  TheRow = Application.Match(Range("A2"), wb.Sheets("Sheet1").Columns(2), 0)
  On Error GoTo 0
If TheRow > 0 Then
  LastCol = Cells(2, Columns.Count).End(xlToLeft).Column
  Cells(2, 2).Resize(, LastCol).ClearContents
  LastCol = wb.Sheets("Sheet1").Cells(TheRow, Columns.Count).End(xlToLeft).Column
  wb.Sheets("Sheet1").Cells(TheRow, 3).Resize(, LastCol - 2).Copy Range("B2")
  End If
End Sub

 

[arif]

Hi,

See the attached workbook. The workbook name must be in A1 and the record number in A2.

Sub Button1_Click()
Dim wb As Workbook, TheRow As Long
Dim LastCol As Long
Set wb = Workbooks(Sheets("Sheet1").Range("A1").Value)
  On Error Resume Next
  TheRow = Application.Match(Range("A2"), wb.Sheets("Sheet1").Columns(2), 0)
  On Error GoTo 0
If TheRow > 0 Then
  LastCol = Cells(2, Columns.Count).End(xlToLeft).Column
  Cells(2, 2).Resize(, LastCol).ClearContents
  LastCol = wb.Sheets("Sheet1").Cells(TheRow, Columns.Count).End(xlToLeft).Column
  wb.Sheets("Sheet1").Cells(TheRow, 3).Resize(, LastCol - 2).Copy Range("B2")
  End If
End Sub

Sir

How to use above codes for two workbooks i have attached and how to run them plz

How to execute the same actions with these two workbooks plz