Exclude a specific value in a select row in list box, into multiple sheets


Board Regular
Apr 27, 2012
Hi Everyone
I have a spreadsheet in VBA that uses sheet1 as a main table data.
I use a table on sheet2 to fill up, the specific product (PPPP) as a subset, from sheet1 data.

The objective that I would like to do is:
Whenever on the sheet1, makes any changes to that specific product (PPPP), such as deleting a row, it makes the change on sheet2, erasing the correspondent row.

Well, the first mistake: being sheet1 and sheet2 tables, the "IDs" do not match. The first movement that is excluded, it is all right, but in a second change it is not already working. How to overcome?
I ask for your precious help as usual.
My anticipated thanks.

On table(sheet1) I have:
- Combobox1 for choose the Month
- Listbox1 to show all data dependent of that Month.
- Listbox2 to show the selection row.
- Listbox3 to show the "ID" ever that specific product is selected.
- Commandbutton1 for exit and
- Commandbutton2 for delete
Thank you very much.
my code:
VBA Code:
Option Explicit

Private Sub ComboBox1_Change()
Sheet3.Range("k2") = ComboBox1.Value 'code
Call Filtro   ''Modulo1
Call MacroPed ''Modulo2
End Sub

Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub CommandButton2_Click() 'DELETE
Application.ScreenUpdating = False

Dim i, iu As Long
Dim ws As Worksheet
Dim r As Long
Dim NextRow As Long

On Error Resume Next
'delete other data
Set ws = Sheets("sheet2")
NextRow = ws.Range("b" & Rows.Count).End(xlUp).Row + 5

If ListBox1.Value = "" Then
    MsgBox ("Please fill up, the Months or Value commands, and select them")
End If

With ListBox1

    If MsgBox("Are you sure you want to delete this row?", vbYesNo + vbQuestion, "Delete row") = vbYes Then
       For i = 1 To Sheet1.Range("b10000").End(xlUp).Row
         If Sheet1.Cells(i, "B") = Val(Me.ListBox1.Column(0)) Then
              Sheet1.Range("B" & i).EntireRow.Delete
         End If
       Next i
 'delete in two sheets data productPPPP
      Call DeleteData ''Modulo4
    End If
End With
Label5.Caption = "Row Delete"
Application.ScreenUpdating = True

End Sub

Private Sub ListBox1_Click()

Dim i, yu As Long

On Error Resume Next

  With ListBox2
    For i = 0 To 5
        .List(.ListCount - 1, i) = ListBox1.List(ListBox1.ListIndex, i)
    Next i
  End With

    With ListBox3
    For yu = 0 To 6
        .List(.ListCount - 1, yu) = ListBox1.List(ListBox1.ListIndex, yu)
    Next yu
  End With

End Sub

Private Sub UserForm_Initialize()

Dim Base As Range
Dim Nome As String
Dim L As Long

L = Sheet1.Range("b1").CurrentRegion.Rows.Count

Set Base = _
Sheet1.Range(Sheet1.Cells(2, 2), Sheet1.Cells(L, 7))
Nome = "'" & Sheet1.Name & "'!"

Me.ComboBox1.List = Array("JANUARY", "FEBRUARY", _
                    "MARCH", "APRIL", "MAY", "JUNE", "JULY", "AUGUST")

End Sub
Sub Filtro()
Dim Base As Range 'declarar a variavel
Dim crt As Range 'declarar criterio
Dim filtrada As Range 'variável do entrevalo das celulas onde estão os dados filtrados
Dim Nome As String 'vai receber a sheet onde está
Dim L As Long 'vai recer toda a quantidade de linhas da tabela

Set Base = Sheet1.Range("b1").CurrentRegion
Set crt = Sheet3.Range("k1:k2")

Base.AdvancedFilter xlFilterCopy, crt, Sheet3.Range("b1:g1")
L = Sheet3.Range("b1").CurrentRegion.Rows.Count

Set filtrada = _
Sheet3.Range(Sheet3.Cells(2, 2), Sheet3.Cells(L, 8))

Nome = "'" & Sheet3.Name & "'!"

UserForm1.ListBox1.RowSource = Nome & filtrada.Address

'para o caso de se digitar valores que não estejam nos dados gerais
UserForm1.ListBox1.ColumnHeads = True

If L = 1 Then UserForm1.ListBox1.ColumnHeads = False

End Sub
VBA Code:
Option Explicit
 Option Base 1

Sub DeleteData()

Application.ScreenUpdating = False
    Dim cell As Range
    Dim ws As Worksheet
    Dim lRow As Long
    Dim IDRef As String

    IDRef = InputBox("Please enter the selected ID.")
    If IDRef = vbNullString Then Exit Sub
      For Each ws In Worksheets
    lRow = Range("b" & Rows.Count).End(xlUp).Row
       For Each cell In Range("b2:b" & lRow)
            If cell = IDRef Then
            End If
    Next cell
    Next ws

Application.ScreenUpdating = True
Application.CutCopyMode = False

End Sub

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).

Watch MrExcel Video

Forum statistics

Latest member

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back