bring data from sheet to another based on cell value

**Carim** · Jan 18th 2021

Quote from Carim

Since you are in a learning process ...

In order to design a VBA solution to Filter and copy filtered rows back to your sheet ... take a look at following thread :

copy rows with filter based on values in another sheet

Hope this will help

Display More

Thanks to Mumps ... who took the time to write the whole Autofilter macro for you ...

Mumps · Jan 18th 2021

Carim

Thank you for the kind words. You are always a gentleman.

leap-out

The problem was being caused by the fact that CUS1009 does not exist for INV10002. Try this version of the macro.

Code

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
Application.ScreenUpdating = False
Dim srcWS As Worksheet, lRow As Long
Set srcWS = Sheets("DATA")
If Target.Address(0, 0) = "E5" Then
With srcWS
If WorksheetFunction.CountIf(.Range("B:B"), Target.Value) <> 0 Then
lRow = Range("B" & Rows.Count).End(xlUp).Row + 1
.Range("A1").AutoFilter 2, Target.Value
If WorksheetFunction.CountIf(srcWS.Range("C2", srcWS.Range("C" & srcWS.Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible), Target.Offset(3).Value) = 0 Then
MsgBox ("The Customer ID '" & Target.Offset(3).Value & "' does not exist" & Chr(10) & "for Invoice Number: " & Target.Value & ".")
.Range("A1").AutoFilter
Exit Sub
End If
.Range("A1").AutoFilter 3, Target.Offset(3).Value
.Range("D2", .Range("I" & .Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy Range("B" & lRow)
.Range("A1").AutoFilter
Else
MsgBox "No match found for " & Target.Value & "."
Exit Sub
End If
End With
End If
Application.ScreenUpdating = True
End Sub

Display More

leap-out · Jan 18th 2021

I thought just fill in e5 but I have to write in e5, e8 to show the result yes it works very well but i don't want every time i write in e5,e8 copy to the bottom repeatedly I want delete old data in sheet "invoice" when i search a new data and if there is no match data also clear the cells

Mumps · Jan 19th 2021

Try:

Code

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim srcWS As Worksheet, lRow As Long
Set srcWS = Sheets("DATA")
lRow = Range("B" & Rows.Count).End(xlUp).Row
If Target.Address(0, 0) = "E5" Then
If lRow <= 15 Then lRow = 16
Range("B16:H" & lRow).ClearContents
With srcWS
If WorksheetFunction.CountIf(.Range("B:B"), Target.Value) <> 0 Then
lRow = Range("B" & Rows.Count).End(xlUp).Row + 1
.Range("A1").AutoFilter 2, Target.Value
If WorksheetFunction.CountIf(srcWS.Range("C2", srcWS.Range("C" & srcWS.Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible), Target.Offset(3).Value) = 0 Then
MsgBox ("The Customer ID '" & Target.Offset(3).Value & "' does not exist" & Chr(10) & "for Invoice Number: " & Target.Value & ".")
.Range("A1").AutoFilter
Application.EnableEvents = True
Exit Sub
End If
.Range("A1").AutoFilter 3, Target.Offset(3).Value
.Range("D2", .Range("I" & .Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy Range("B" & lRow)
.Range("A1").AutoFilter
Else
MsgBox "No match found for " & Target.Value & "."
Exit Sub
End If
End With
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Display More

leap-out · Jan 19th 2021

actually it gives me error I think you have typo about end with & end if but seem the code doesn't work ,

may you check it please?

Mumps · Jan 19th 2021

Try the attached file. It works properly for me.

leap-out · Jan 19th 2021

curiosity , if I want to search based only e5 and cancel e8 from the code which line to adjusting

Mumps · Jan 19th 2021

When you want to search based only on E5, first delete any value in E8 so that E8 is blank and then enter a value in E5.

Code

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim srcWS As Worksheet, lRow As Long
Set srcWS = Sheets("DATA")
lRow = Range("B" & Rows.Count).End(xlUp).Row
If Target.Address(0, 0) = "E5" Then
If Range("E8") <> "" Then
If lRow <= 15 Then lRow = 16
Range("B16:H" & lRow).ClearContents
With srcWS
If WorksheetFunction.CountIf(.Range("B:B"), Target.Value) <> 0 Then
lRow = Range("B" & Rows.Count).End(xlUp).Row + 1
.Range("A1").AutoFilter 2, Target.Value
If WorksheetFunction.CountIf(srcWS.Range("C2", srcWS.Range("C" & srcWS.Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible), Target.Offset(3).Value) = 0 Then
MsgBox ("The Customer ID '" & Target.Offset(3).Value & "' does not exist" & Chr(10) & "for Invoice Number: " & Target.Value & ".")
.Range("A1").AutoFilter
Application.EnableEvents = True
Exit Sub
End If
.Range("A1").AutoFilter 3, Target.Offset(3).Value
.Range("D2", .Range("I" & .Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy Range("B" & lRow)
.Range("A1").AutoFilter
Else
MsgBox ("The Invoice Number: " & Target.Value & " does not exist.")
Application.EnableEvents = True
Exit Sub
End If
End With
Else
If lRow <= 15 Then lRow = 16
Range("B16:H" & lRow).ClearContents
With srcWS
If WorksheetFunction.CountIf(.Range("B:B"), Target.Value) <> 0 Then
lRow = Range("B" & Rows.Count).End(xlUp).Row + 1
.Range("A1").AutoFilter 2, Target.Value
.Range("D2", .Range("I" & .Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy Range("B" & lRow)
Else
MsgBox ("The Invoice Number: " & Target.Value & " does not exist.")
End If
.Range("A1").AutoFilter
End With
End If
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Display More

leap-out · Jan 19th 2021

astonishing just I try doing last thing , but I failed I added this line to show the customer in e8

but not work exactly it shows two values in e8 and e9

Code

.Range("c2", .Range("c" & .Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy Range("e8")

Mumps · Jan 19th 2021

Try the attached.

leap-out · Jan 19th 2021

nothing happened in e8 it supposes showing number of customer when write in e5

Mumps · Jan 20th 2021

I'm not sure what you mean. The macro works in the following way:

-If E8 is not blank, when you change the value in E5, the macro will return only the rows from DATA that contain the E5 Invoice # in column B and the E8 ID in column C.

-If E8 is blank, when you change the value in E5, the macro will return all the rows from DATA that contain the E5 Invoice # in column B regardless of the ID in column C.

If this is not what you want, please explain in detail using a few examples form your data.

leap-out · Jan 20th 2021

first of all thanks for your time and feedback what I meant should e8 is empty , I do not fill it at all it fills automatically when I fill in e5 bring customer id and fill in e8 for instance if I only fill in e5 "1004 then automatically fill in e8 "CUS1012" and the rests of data from row 16

Mumps · Jan 21st 2021

Try:

Code

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim srcWS As Worksheet, lRow As Long
Set srcWS = Sheets("DATA")
lRow = Range("B" & Rows.Count).End(xlUp).Row
If Target.Address(0, 0) = "E5" Then
If lRow <= 15 Then lRow = 16
Range("B16:H" & lRow).ClearContents
With srcWS
If WorksheetFunction.CountIf(.Range("B:B"), Target.Value) <> 0 Then
lRow = Range("B" & Rows.Count).End(xlUp).Row + 1
.Range("A1").AutoFilter 2, Target.Value
.Range("D2", .Range("I" & .Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy Range("B" & lRow)
Range("E8") = .Range("C2", .Range("C" & .Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1)
.Range("A1").AutoFilter
Else
MsgBox ("The Invoice Number: " & Target.Value & " does not exist.")
Application.EnableEvents = True
Exit Sub
End If
End With
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Display More

leap-out · Jan 21st 2021

Brilliant ! awesome ! well-done ! what I can say you honestly you are legend , thanks is not enough for your right

many thanks for your codes and time and patience and everything

best regards,

leap-out

Mumps · Jan 21st 2021

My pleasure.

Share