Results 1 to 10 of 10
Like Tree2Likes
  • 1 Post By DeusXv
  • 1 Post By HalfAce

Excel Macro - if cell contains "x" then copy and paste cell

This is a discussion on Excel Macro - if cell contains "x" then copy and paste cell within the Excel Questions forums, part of the Question Forums category; Looking for some help to write a macro to do the following: If cell in column "F" = "Chicago" then ...

  1. #1
    New Member
    Join Date
    Feb 2012
    Posts
    31

    Default Excel Macro - if cell contains "x" then copy and paste cell

    Looking for some help to write a macro to do the following:

    If cell in column "F" = "Chicago" then copy formula in cell V1 to Column V in the same row as "Chicago" and formula in cell W1 to Column W in same row as "Chicago" and formula in cell X1 to column X in same row as "Chicago"

    If cell in column "F" = "New York" then copy formula in cell V1 to Column V in the same row as "New York" and formula in cell W1 to column W in same row as "New York" and formulas in cell X1 to column X in same row as "New York"

    I will need to continue this for a number of different values from column F, but if someone could help me get started, I would greatly appreciate it!

  2. #2
    Board Regular
    Join Date
    Jul 2013
    Location
    Cork, Ireland
    Posts
    616

    Default Re: Excel Macro - if cell contains "x" then copy and paste cell

    You can use the same code that we used for the searching for names just change what happens when you find the names, something like this

    Code:
    Sub SearchMacro()
    
    
    
    
    Dim LR As Long, i As Long
        With Sheets("Sheet1")
            LR = .Range("A" & Rows.Count).End(xlUp).Row
            For i = 1 To LR
                With .Range("A" & i)
                    If .Value = "Bob" Then
                        Sheets("Sheet1").Range("A1:A1").Copy Destination:=Sheets("Sheet1").Range("A2:A2")
                    ElseIf .Value = "Fred" Then
                        Sheets("Sheet1").Range("A1:A1").Copy Destination:=Sheets("Sheet1").Range("A2:A2")
                    ElseIf .Value = "Tom" Then
                        Sheets("Sheet1").Range("A1:A1").Copy Destination:=Sheets("Sheet1").Range("A2:A2")
                    End If
                End With
            Next i
        End With
    
    
    
    
    End Sub
    BunrattyCastle69 likes this.

    - Posting guidelines, forum rules and terms of use

    - Try searching for your answer first, see how

    - Read the FAQs

    - List of BB codes

    - List of VBA Books/Tutorials And Sites

    - Use the Board HTML Maker to post your data to the board



  3. #3
    MrExcel MVP HalfAce's Avatar
    Join Date
    Apr 2003
    Location
    Alaska
    Posts
    9,232

    Default Re: Excel Macro - if cell contains "x" then copy and paste cell

    Depending on how many different cities you may want to search through / for, you may not want to try and include all possibilities in your code so here's another idea that allows you to specify one city at a time.
    (Note, if you only have a handful of cities that will never change then I might go with something like what DeusXv posted, but if that's not going to be the case then this would be somewhat more dynamic.)
    Code:
    Option Compare Text
    Sub LoopThroughCities()
    Dim LstRw As Long, ThsRw As Long, ThsCity As String
    LstRw = Cells(Rows.Count, "F").End(xlUp).Row
    ThsCity = InputBox("Which city do you want to search for?")
    If Len(ThsCity) = 0 Then Exit Sub
    For ThsRw = 2 To LstRw
      If Cells(ThsRw, "F").Value = ThsCity Then _
        Cells(1, "V").Resize(, 3).Copy Cells(ThsRw, "V")
    Next
    End Sub
    Hope it helps.
    BunrattyCastle69 likes this.
    My greatest fear is that when I die my wife will sell my guns and my hot rod for what I told her they cost ...


  4. #4
    New Member
    Join Date
    Feb 2012
    Posts
    31

    Default Re: Excel Macro - if cell contains "x" then copy and paste cell

    DeusXv - this seems like it will work, but instead of making the paste destination a specific cell, i just want to paste it in a column on the same row. And it looks like the formula wants me to specify a certain cell to paste to. (The formulas I am copying will always be in the same cell - V1, W1 and X1 - but where I am pasting to will change - column V, W and X in the same row where it located what I am searching for). And also, I need to copy & paste 3 different cells for each city, not sure if I stated that in my original question.

    I hope this makes sense.

    Thanks so much for your help!

  5. #5
    New Member
    Join Date
    Feb 2012
    Posts
    31

    Default Re: Excel Macro - if cell contains "x" then copy and paste cell

    HalfAce - thank you so much for your response!

    At this time, I only have 4 cities I am working with, but thanks for the suggestion!!

  6. #6
    MrExcel MVP HalfAce's Avatar
    Join Date
    Apr 2003
    Location
    Alaska
    Posts
    9,232

    Default Re: Excel Macro - if cell contains "x" then copy and paste cell

    So, have you tried the code posted above?
    There are a number of ways I can think of to do this but they all sort of depend on exactly what you're doing each time you do it.

    Are you doing it for each city every time you do it?
    Do you expect to have many more cities before you're through?
    Do you want it to require clicking a button to make it happen, or would you rather have it happen with a double click on a city or something similar?
    Would you rather have the cities in a dropdown (data validation) cell where the code automatically fires off when one of them gets selected?
    As I said, I can think of a number of ways to achieve the goal with as little effort as possible. Which way to go just depends...
    My greatest fear is that when I die my wife will sell my guns and my hot rod for what I told her they cost ...


  7. #7
    New Member
    Join Date
    Feb 2012
    Posts
    31

    Default Re: Excel Macro - if cell contains "x" then copy and paste cell

    Yes, I tried both of the codes posted above and none are doing what I need. But I think I haven't been explaining it correctly. Below is an exerpt from a sample file, that hopefully will help.

    What I need to do is if Column A = "Chicago", then copy the formulas in H1 and I1 and paste them columns H & I to all the rows that have Chicago in Column A (in the example, they will paste to the Studio Split and Studio Minimum columns). Then do the same thing for when column A = "New York". For any other cities (such as Miami and Las Vegas in the example), do nothing.



    A B C D E F G H I
    formula #1 formula #2
    City Product Desc Code PROD TITLE DES Product Desc Code Start Date Split Minimum Studio Split Studio Minimum
    Chicago 1307634 PREMIUM MOVIE 07634 130326 0.25 1.00
    Chicago 1307634 PREMIUM MOVIE 07634 130326 0.25 1.00
    Chicago 1307638 PREMIUM MOVIE 07638 130409 0.25 1.00
    Chicago 1307638 PREMIUM MOVIE 07638 130409 0.25 1.00
    Chicago 1307639 PREMIUM MOVIE 07639 130416 0.25 1.00
    Chicago 1307639 PREMIUM MOVIE 07639 130416 0.25 1.00
    Miami 1307640 PREMIUM MOVIE 07640 130430 0.25 2.00
    Miami 1307640 PREMIUM MOVIE 07640 130430 0.25 2.00
    Miami 1307640 PREMIUM MOVIE 07640 130430 0.25 2.00
    Miami 1307641 PREMIUM MOVIE 07641 130423 0.25 2.00
    Miami 1307642 PREMIUM MOVIE 07642 130430 0.25 2.00
    Miami 1307643 PREMIUM MOVIE 07643 130402 0.25 2.00
    Miami 1307645 PREMIUM MOVIE 07645 130416 0.25 2.00
    New York 1307645 PREMIUM MOVIE 07645 130416 0.25 3.00
    New York 1307646 PREMIUM MOVIE 07646 130423 0.25 3.00
    New York 1307646 PREMIUM MOVIE 07646 130423 0.25 3.00
    New York 1307646 PREMIUM MOVIE 07646 130423 0.25 3.00
    Las Vegas 1307647 PREMIUM MOVIE 07647 130416 0.25 4.00
    Las Vegas 1307647 PREMIUM MOVIE 07647 130416 0.25 4.00
    Las Vegas 1307647 PREMIUM MOVIE 07647 130416 0.25 4.00
    Las Vegas 1307648 PREMIUM MOVIE 07648 130409 0.25 4.00
    Las Vegas 1307649 PREMIUM MOVIE 07649 130528 0.25 4.00
    Las Vegas 1307649 PREMIUM MOVIE 07649 130528 0.25 4.00
    Las Vegas 1307650 PREMIUM MOVIE 07650 130521 0.25 4.00

  8. #8
    MrExcel MVP HalfAce's Avatar
    Join Date
    Apr 2003
    Location
    Alaska
    Posts
    9,232

    Default Re: Excel Macro - if cell contains "x" then copy and paste cell

    Well, the logic remains the same but the columns have changed from your original post.
    Try this and see if it's what you're wanting to do. It's working for me with the example data you posted.
    (Note though, you have extra spaces in the city names posted so if that's going to be the case in your real data, we can deal with that as well, but I haven't here because I don't know if that's how your data really is or if it's just the way you posted it on the board.)

    Code:
    Option Compare Text
    Sub LoopThroughCities()
    Dim LstRw As Long, ThsRw As Long, ThsCity As String
    LstRw = Cells(Rows.Count, "A").End(xlUp).Row
    ThsCity = InputBox("Which city do you want to search for?")
    If Len(ThsCity) = 0 Then Exit Sub
    For ThsRw = 2 To LstRw
      If Cells(ThsRw, "A").Value = ThsCity Then _
        Cells(1, "H").Resize(, 2).Copy Cells(ThsRw, "H")
    Next
    End Sub
    Hope it helps.
    My greatest fear is that when I die my wife will sell my guns and my hot rod for what I told her they cost ...


  9. #9
    New Member
    Join Date
    Jun 2014
    Location
    Zurich
    Posts
    16

    Default Re: Excel Macro - if cell contains "x" then copy and paste cell

    Quote Originally Posted by DeusXv View Post
    You can use the same code that we used for the searching for names just change what happens when you find the names, something like this

    Code:
    Sub SearchMacro()
    
    
    
    
    Dim LR As Long, i As Long
        With Sheets("Sheet1")
            LR = .Range("A" & Rows.Count).End(xlUp).Row
            For i = 1 To LR
                With .Range("A" & i)
                    If .Value = "Bob" Then
                        Sheets("Sheet1").Range("A1:A1").Copy Destination:=Sheets("Sheet1").Range("A2:A2")
                    ElseIf .Value = "Fred" Then
                        Sheets("Sheet1").Range("A1:A1").Copy Destination:=Sheets("Sheet1").Range("A2:A2")
                    ElseIf .Value = "Tom" Then
                        Sheets("Sheet1").Range("A1:A1").Copy Destination:=Sheets("Sheet1").Range("A2:A2")
                    End If
                End With
            Next i
        End With
    
    
    
    
    End Sub
    Hi There Guys! new to to forum and lovin it already. I have Question which is highly related to this Question above. I want to do the same but not for down in the coloms, but within a row, so instead of Up to Down, From Left to Right.. To make it more clear, I have adjusted the above macro in a way that it works, but would like to do some sort of LOOP or DO UNTIL, to clean up the MACRO: Sub SearchMacro()
    Dim LR As Long, i As Long
    With Sheets("Agreed_Principles")

    With .Range("AD10")
    If .Value = "1" Then
    Sheets("Agreed_Principles").Range("AD26:AD75").Copy Destination:=Sheets("1").Range("AD26:AD75")
    End If
    End With

    With .Range("AE10")
    If .Value = "1" Then
    Sheets("Agreed_Principles").Range("AE26:AE75").Copy Destination:=Sheets("1").Range("AE26:AE75")
    End If
    End With

    With .Range("AF10")
    If .Value = "1" Then
    Sheets("Agreed_Principles").Range("AF26:AF75").Copy Destination:=Sheets("1").Range("AF26:AF75")
    End If
    End With


    End With
    End SubPlease help!

  10. #10
    New Member
    Join Date
    Jun 2014
    Location
    Zurich
    Posts
    16

    Default Re: Excel Macro - if cell contains "x" then copy and paste cell

    Allright, so I have adjusted my MACRO so you can see the Full MACRO which I have running now. My Question is as follows: Is there a way to clean up this MACRO, make it a Do Until version or anything. Any Advice is welcome:
    Code:
    Sub SearchMacro()
    Dim LR As Long, i As Long
        With Sheets("Agreed_Principles")
                
                                        
                    With .Range("AA10")
                    If .Value = "1" Then
                        Sheets("Agreed_Principles").Range("AA26:AA75").Copy
                        Sheets(Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", _
                        "37", "38", "39", "40", "41", "42", "43", "44", "45")).Select
                        Sheets("1").Activate
                        Range("AA26:AA75").Select
                    
                        Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
                        :=False, Transpose:=False
                        
                    End If
                    End With
                
                    With .Range("AB10")
                    If .Value = "1" Then
                        Sheets("Agreed_Principles").Range("AB26:AB75").Copy
                        Sheets(Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", _
                        "37", "38", "39", "40", "41", "42", "43", "44", "45")).Select
                        Sheets("1").Activate
                        Range("AB26:AB75").Select
                    
                        Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
                        :=False, Transpose:=False
                        
                    End If
                    End With
                    
                    With .Range("AC10")
                    If .Value = "1" Then
                        Sheets("Agreed_Principles").Range("AC26:AC75").Copy
                        Sheets(Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", _
                        "37", "38", "39", "40", "41", "42", "43", "44", "45")).Select
                        Sheets("1").Activate
                        Range("AC26:AC75").Select
                    
                        Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
                        :=False, Transpose:=False
                        
                    End If
                    End With
                                    
                    With .Range("AD10")
                    If .Value = "1" Then
                        Sheets("Agreed_Principles").Range("AD26:AD75").Copy
                        Sheets(Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", _
                        "37", "38", "39", "40", "41", "42", "43", "44", "45")).Select
                        Sheets("1").Activate
                        Range("AD26:AD75").Select
                    
                        Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
                        :=False, Transpose:=False
                    
                    End If
                    End With
                    
                    With .Range("AE10")
                    If .Value = "1" Then
                        Sheets("Agreed_Principles").Range("AE26:AE75").Copy
                        Sheets(Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", _
                        "37", "38", "39", "40", "41", "42", "43", "44", "45")).Select
                        Sheets("1").Activate
                        Range("AE26:AE75").Select
                    
                        Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
                        :=False, Transpose:=False
                    
                    End If
                    End With
                                
                    With .Range("AF10")
                    If .Value = "1" Then
                        Sheets("Agreed_Principles").Range("AF26:AF75").Copy
                        Sheets(Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", _
                        "37", "38", "39", "40", "41", "42", "43", "44", "45")).Select
                        Sheets("1").Activate
                        Range("AF26:AF75").Select
                    
                        Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
                        :=False, Transpose:=False
                                
                    End If
                    End With
                    
                    With .Range("AG10")
                    If .Value = "1" Then
                        Sheets("Agreed_Principles").Range("AG26:AG75").Copy
                        Sheets(Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", _
                        "37", "38", "39", "40", "41", "42", "43", "44", "45")).Select
                        Sheets("1").Activate
                        Range("AG26:AG75").Select
                    
                        Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
                        :=False, Transpose:=False
                                
                    End If
                    End With
                    
                    With .Range("AH10")
                    If .Value = "1" Then
                        Sheets("Agreed_Principles").Range("AH26:AH75").Copy
                        Sheets(Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", _
                        "37", "38", "39", "40", "41", "42", "43", "44", "45")).Select
                        Sheets("1").Activate
                        Range("AH26:AH75").Select
                    
                        Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
                        :=False, Transpose:=False
                                
                    End If
                    End With
                    
                    With .Range("AI10")
                    If .Value = "1" Then
                        Sheets("Agreed_Principles").Range("AI26:AI75").Copy
                        Sheets(Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", _
                        "37", "38", "39", "40", "41", "42", "43", "44", "45")).Select
                        Sheets("1").Activate
                        Range("AI26:AI75").Select
                    
                        Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
                        :=False, Transpose:=False
                                
                    End If
                    End With
                    
                    With .Range("AJ10")
                    If .Value = "1" Then
                        Sheets("Agreed_Principles").Range("AJ26:AJ75").Copy
                        Sheets(Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", _
                        "37", "38", "39", "40", "41", "42", "43", "44", "45")).Select
                        Sheets("1").Activate
                        Range("AJ26:AJ75").Select
                    
                        Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
                        :=False, Transpose:=False
                                
                    End If
                    End With
                    
                    With .Range("AK10")
                    If .Value = "1" Then
                        Sheets("Agreed_Principles").Range("AK26:AK75").Copy
                        Sheets(Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", _
                        "37", "38", "39", "40", "41", "42", "43", "44", "45")).Select
                        Sheets("1").Activate
                        Range("AK26:AK75").Select
                    
                        Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
                        :=False, Transpose:=False
                                
                    End If
                    End With
                    
                    With .Range("AL10")
                    If .Value = "1" Then
                        Sheets("Agreed_Principles").Range("AL26:AL75").Copy
                        Sheets(Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", _
                        "37", "38", "39", "40", "41", "42", "43", "44", "45")).Select
                        Sheets("1").Activate
                        Range("AL26:AL75").Select
                    
                        Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
                        :=False, Transpose:=False
                                
                    End If
                    End With
        End With
    End Sub

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  


DMCA.com