Automatization based on cells

Eziooh

New Member
Joined
Apr 1, 2019
Messages
17
Hello, I have 3 tables and I need to get a register from table 1 to table 3 based on a choose on table 2. I need to get it automatized.
This is my code at the moment.
I hope you guys can help me.

Code:
Option Compare Text
Dim espaco As Range 'You can use this variable to get the range from row 7


Sub search()


Dim lastrow As Long
Dim Cell, cRange As Range
Dim value, result As String
valor = Worksheets("Table1").Range("D7").Value ' I need this to be a variable on row 7
lastrow = Sheets("Table3").Cells(Rows.Count, 4).End(xlUp).Offset(1).Row


' Range to see
    Set cRange = Worksheets("Artigos").Range("A1:B1000")
' For which cell in range
        For Each Cell In cRange


            If Cell.Value = valor Then


              resultado = Cell.Offset(0, -1).Value
             'Range("D" & Rows.Count).End(xlUp).Offset(1, 4).Select
            'ActiveCell.End(xlDown).Offset(3, 4).Select
            'ActiveCell.Value = resultado
            Sheets("Table3").Cells(lastrow, 4) = resultado
End If
' Check next cell in range
        Next Cell


End Sub

****** id="cke_pastebin" style="position: absolute; top: 56px; width: 1px; height: 1px; overflow: hidden; left: -1000px;">Option Compare Text
Dim espaco As Range


Sub search()


Dim lastrow As Long
Dim Cell, cRange As Range
Dim value, result As String
valor = Worksheets("Table1").Range("D7").Value ' I need this to be a variable on row 7
lastrow = Sheets("Table3").Cells(Rows.Count, 4).End(xlUp).Offset(1).Row


' Range to see
Set cRange = Worksheets("Artigos").Range("A1:B1000")
' For which cell in range
For Each Cell In cRange


If Cell.Value = valor Then


resultado = Cell.Offset(0, -1).Value
'Range("D" & Rows.Count).End(xlUp).Offset(1, 4).Select
'ActiveCell.End(xlDown).Offset(3, 4).Select
'ActiveCell.Value = resultado
Sheets("Table3").Cells(lastrow, 4) = resultado
End If
' Check next cell in range
Next Cell


End Sub



 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
Try:
Code:
Sub search()
    Application.ScreenUpdating = False
    Dim lastRow As Long, Cel, cRange As Range, valor As Range, result As String
    lastRow = Sheets("Artigos").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set valor = Worksheets("Table1").Range("D7")
    For Each Cel In Sheets("Artigos").Range("A1:A" & lastRow)
        If Cel.value = valor Then
            Sheets("Table3").Cells(Rows.Count, 4).End(xlUp).Offset(1, 0) = Cel.Offset(0, -1)
        End If
    Next Cel
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Okay, that does the trick, but how can I have that ("D7") as dinamic when worksheet changes? When I do

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = ("D7") Then
        Call search(Target)
    End If
End Sub
Like this, my macro doesn't run...
And yes, I tweaked a bit the code, but still nothing...
 
Last edited:
Upvote 0
Do you want to search column A of Sheet "Artigos" for the value of D7 in sheets "Table1"? Is the value in D7 entered manually or is it the result of a formula?
 
Upvote 0
Place this macro in the code module for sheet "Table1".
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("D7")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim fnd As Range
    Set fnd = Sheets("Artigos").Range("A:A").Find(Target.value, LookIn:=xlValues, lookat:=xlWhole)
    If Not fnd Is Nothing Then
        Sheets("Table3").Cells(Rows.Count, 4).End(xlUp).Offset(1, 0) = fnd.Offset(0, -1)
    End If
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Change
Code:
Range("D7")
to
Code:
Range("D7:F7")
 
Upvote 0
Which line of code is highlighted when you click "Debug"? Please post your revised code that is giving you the error.
 
Upvote 0

Forum statistics

Threads
1,213,532
Messages
6,114,176
Members
448,554
Latest member
Gleisner2

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
Back
Top