Assign macro

[proexcel]

I have one combo box and a buttom
I have this table in excel
date name goods name Qty
21-1-2018 David Pen 12
22-1-2018 Peter pencil 14
10-2-2018 David paper 23
12-2-2018 Peter pen 43

In the combo box we have David and peter so I want that when I choose David and press the bottom so it show me just David info in another sheet
how can I do that?

 

[ranman256]

either , goto the page with David info,
or
load the items in the combo (if your combo is set to show 4 cols)

vDate = cboBox.column(0)
vName =cboBox.column(1)
vUtil =cboBox.column(2)
vQty =cboBox.column(3)

 

[cooper645]

Please take note of the blue text and amend to suit your needs the red text.

I assumed that your example data was a simplified version of what you were trying to achieve.

Option Explicit


Sub CopyTransToNew()

'Declarations
Dim LastRow As Long, c As Range, chk As String, LastCol As Long, data As Worksheet, i As Long

'Delete Extracted sheet if it exists
On Error Resume Next
Application.DisplayAlerts = False
 Sheets("Extracted").Delete
Application.DisplayAlerts = True

[COLOR=#0000ff]'change this from input box to your combobox name.value[/COLOR]
chk = [COLOR=#ff0000]InputBox("Name")[/COLOR]

'declare data to be sheet1 - [COLOR=#0000ff]amend sheet1 to whatever your data sheet is called[/COLOR]
Set data = Sheets("[COLOR=#ff0000]Sheet1[/COLOR]")

'select the data sheet
data.Select

'find the last row and column to make this code more dynamic
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column

'add a new Extraction sheet   
Sheets.Add after:=ActiveSheet
ActiveSheet.Name = "Extracted"

'Insert the same headers
data.Range("1:1").Copy Sheets("Extracted").Range("A1")

'Loop through column B looking for chk value and copy the columns left and right in that row to extraction sheet
data.Select


   For Each c In data.Range("B2:B" & LastRow)
    If c = chk Then
    c.Select
      With Sheets("Extracted").Range("B" & Rows.Count).End(xlUp)
         For i = -1 To LastCol
         .Offset(1, i).Value = ActiveCell.Offset(0, i).Value
         Next i
      End With
  End If
   Next c
   
End Sub