Certain cell Colour to Copy across once activated

[Mike1971]

Hi All,

Hope you can help.

I have created a search bar that highlights the entire row when typing in either name of street, map no, map name, postcode etc-When i type in the Name of a street it highlights it with a specific colour
and the same for thing map no etc and then that shows up as blue etc. These lines disappear when the search bar cell has been deleted of search words.

This list is very long and i wish to create a results table next to the list so i dont have to go through all the lines and scroll through them.

I would like to know how to create a formula or how to use a macro to say for example if in column A3- A500 say appears to come up as gold colour then copy it to i3,etc-so i have a neat list at the top.

Not very good at explaining , but hopefully the pic will help,

Please advise
Regards
Mike

 

[kanadaaa]

Try this in the sheet's module:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long, lrLeft As Long, lrRight As Long
    
    If Target.Address = Range("A2").Address Or Target.Address = Range("B2").Address Or Target.Address = Range("C2").Address _
        Or Target.Address = Range("F2").Address Or Target.Address = Range("G2").Address Then 'If A2, B2, C2, F2, or G2 is changed
        
        'If not blank after change, output values
        If Range("A2") <> "" Or Range("B2") <> "" Or Range("C2") <> "" Or Range("F2") <> "" Or Range("G2") <> "" Then
            lrLeft = Range("A" & Rows.Count).End(xlUp).Row
            Application.ScreenUpdating = False
            For i = 3 To lrLeft
                If Cells(i, lrLeft).Interior.ColorIndex <> -4142 Then
                    lrRight = Range("I" & Rows.Count).End(xlUp).Row + 1
                    Cells(lrRight, "I").Resize(, Columns("G").Column).Value = Cells(i, "A").Resize(, Columns("G").Column).Value
                End If
            Next i
            Application.ScreenUpdating = True
            
        'If not blank after change clear values
        Else
            lrRight = Range("I" & Rows.Count).End(xlUp).Row + 1
            Range(Cells(3, "I"), Cells(lrRight, "O")).Value = ""
        End If
        
    End If
End Sub

 

[kanadaaa]

Sorry I found a mistake in the code. Try this one:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long, lrLeft As Long, lrRight As Long
   
    If Target.Address = Range("A2").Address Or Target.Address = Range("B2").Address Or Target.Address = Range("C2").Address _
        Or Target.Address = Range("F2").Address Or Target.Address = Range("G2").Address Then 'If A2, B2, C2, F2, or G2 is changed
       
        'If not blank after change, output values
        If Range("A2") <> "" Or Range("B2") <> "" Or Range("C2") <> "" Or Range("F2") <> "" Or Range("G2") <> "" Then
            lrLeft = Range("A" & Rows.Count).End(xlUp).Row
            Application.ScreenUpdating = False
            For i = 3 To lrLeft
                If Cells(i, 1).Interior.ColorIndex <> -4142 Then
                    lrRight = Range("I" & Rows.Count).End(xlUp).Row + 1
                    Cells(lrRight, "I").Resize(, Columns("G").Column).Value = Cells(i, "A").Resize(, Columns("G").Column).Value
                End If
            Next i
            Application.ScreenUpdating = True
           
        'If blank after change clear values
        Else
            lrRight = Range("I" & Rows.Count).End(xlUp).Row + 1
            Range(Cells(3, "I"), Cells(lrRight, "O")).Value = ""
        End If
       
    End If
End Sub

 

[Mike1971]

Sorry I found a mistake in the code. Try this one:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long, lrLeft As Long, lrRight As Long
 
    If Target.Address = Range("A2").Address Or Target.Address = Range("B2").Address Or Target.Address = Range("C2").Address _
        Or Target.Address = Range("F2").Address Or Target.Address = Range("G2").Address Then 'If A2, B2, C2, F2, or G2 is changed
     
        'If not blank after change, output values
        If Range("A2") <> "" Or Range("B2") <> "" Or Range("C2") <> "" Or Range("F2") <> "" Or Range("G2") <> "" Then
            lrLeft = Range("A" & Rows.Count).End(xlUp).Row
            Application.ScreenUpdating = False
            For i = 3 To lrLeft
                If Cells(i, 1).Interior.ColorIndex <> -4142 Then
                    lrRight = Range("I" & Rows.Count).End(xlUp).Row + 1
                    Cells(lrRight, "I").Resize(, Columns("G").Column).Value = Cells(i, "A").Resize(, Columns("G").Column).Value
                End If
            Next i
            Application.ScreenUpdating = True
         
        'If blank after change clear values
        Else
            lrRight = Range("I" & Rows.Count).End(xlUp).Row + 1
            Range(Cells(3, "I"), Cells(lrRight, "O")).Value = ""
        End If
     
    End If
End Sub

Sorry I found a mistake in the code. Try this one:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long, lrLeft As Long, lrRight As Long
  
    If Target.Address = Range("A2").Address Or Target.Address = Range("B2").Address Or Target.Address = Range("C2").Address _
        Or Target.Address = Range("F2").Address Or Target.Address = Range("G2").Address Then 'If A2, B2, C2, F2, or G2 is changed
      
        'If not blank after change, output values
        If Range("A2") <> "" Or Range("B2") <> "" Or Range("C2") <> "" Or Range("F2") <> "" Or Range("G2") <> "" Then
            lrLeft = Range("A" & Rows.Count).End(xlUp).Row
            Application.ScreenUpdating = False
            For i = 3 To lrLeft
                If Cells(i, 1).Interior.ColorIndex <> -4142 Then
                    lrRight = Range("I" & Rows.Count).End(xlUp).Row + 1
                    Cells(lrRight, "I").Resize(, Columns("G").Column).Value = Cells(i, "A").Resize(, Columns("G").Column).Value
                End If
            Next i
            Application.ScreenUpdating = True
          
        'If blank after change clear values
        Else
            lrRight = Range("I" & Rows.Count).End(xlUp).Row + 1
            Range(Cells(3, "I"), Cells(lrRight, "O")).Value = ""
        End If
      
    End If
End Sub

Thank you so much Kanadaa, that's a lot of code. Thank you for taking the time to look at the problem for me and write a code.
I have never written code before apart from one liners in a cell. I don't even know how to bring up the area to put this code in and then how then do I save the code so that it runs in the background.
Sorry for asking.

 

[kanadaaa]

Thank you so much Kanadaa, that's a lot of code.

You're welcome. It's actually nothing because it took only a couple of minutes to write the code.

I have never written code before apart from one liners in a cell. I don't even know how to bring up the area to put this code in and then how then do I save the code so that it runs in the background.

1. If your current workbook isn’t a macro-enabled workbook, save it as an .xlsm file
2. If you don’t have the developer tab in the ribbon, turn it on (see Developer Tab in Excel)
3. Open the code tab. In the Project tab in it, you'll see a list of worksheets you have. Choose one into which you want to install the automatic fill-in function.
4. Copy and paste the code into the sheet module
5. Exit the code tab and try typing something into a search bar and see if it works

 

[Mike1971]

You're welcome. It's actually nothing because it took only a couple of minutes to write the code.

1. If your current workbook isn’t a macro-enabled workbook, save it as an .xlsm file
2. If you don’t have the developer tab in the ribbon, turn it on (see Developer Tab in Excel)
3. Open the code tab. In the Project tab in it, you'll see a list of worksheets you have. Choose one into which you want to install the automatic fill-in function.
4. Copy and paste the code into the sheet module
5. Exit the code tab and try typing something into a search bar and see if it works

 

[Mike1971]

I Have copied and pasted the code but guessing its me doing something wrong here being a complete novice but at the moment it doesnt seem to work.

I have now the development added so thank you for that but other than that i am lost .Not sure also how to enable macro enabled workbook. Have tried but may have messed it up.

 

[kanadaaa]

You've pasted the code into the right place the right way.
I think your workbook still isn't a macro-enabled workbook, which is presumably why you can't get the code to work.
Check the following images:

 

[Mike1971]

You've pasted the code into the right place the right way.
I think your workbook still isn't a macro-enabled workbook, which is presumably why you can't get the code to work.
Check the following images:

View attachment 32714

View attachment 32715

View attachment 32716

Morning Kanadaa
Thank you,

I have now enabled the macro, but with no success-Perhaps i should upload a mini sheet to see if you can try it-not sure how that works or send you the data sheet itself.

 

[Mike1971]

Morning Kanadaa
Thank you,

I have now enabled the macro, but with no success-Perhaps i should upload a mini sheet to see if you can try it-not sure how that works or send you the data sheet itself.
View attachment 32740View attachment 32739View attachment 32744

Did notice there was no (*xlsm) at the end of my save excel macro enabled but guessing that shoudnt make a difference?