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

rlesse83

New Member
Joined
Feb 4, 2012
Messages
31
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!
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
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
 
Upvote 0
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.
 
Upvote 0
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!
 
Upvote 0
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!! :)
 
Upvote 0
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...
 
Upvote 0
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.



ABCDEFG H I
formula #1 formula #2
CityProduct Desc CodePROD TITLE DESProduct Desc CodeStart Date Split Minimum Studio Split Studio Minimum
Chicago1307634PREMIUM MOVIE07634130326 0.25 1.00
Chicago1307634PREMIUM MOVIE07634130326 0.25 1.00
Chicago1307638PREMIUM MOVIE07638130409 0.25 1.00
Chicago1307638PREMIUM MOVIE07638130409 0.25 1.00
Chicago1307639PREMIUM MOVIE07639130416 0.25 1.00
Chicago1307639PREMIUM MOVIE07639130416 0.25 1.00
Miami1307640PREMIUM MOVIE07640130430 0.25 2.00
Miami1307640PREMIUM MOVIE07640130430 0.25 2.00
Miami1307640PREMIUM MOVIE07640130430 0.25 2.00
Miami1307641PREMIUM MOVIE07641130423 0.25 2.00
Miami1307642PREMIUM MOVIE07642130430 0.25 2.00
Miami1307643PREMIUM MOVIE07643130402 0.25 2.00
Miami1307645PREMIUM MOVIE07645130416 0.25 2.00
New York1307645PREMIUM MOVIE07645130416 0.25 3.00
New York1307646PREMIUM MOVIE07646130423 0.25 3.00
New York1307646PREMIUM MOVIE07646130423 0.25 3.00
New York1307646PREMIUM MOVIE07646130423 0.25 3.00
Las Vegas1307647PREMIUM MOVIE07647130416 0.25 4.00
Las Vegas1307647PREMIUM MOVIE07647130416 0.25 4.00
Las Vegas1307647PREMIUM MOVIE07647130416 0.25 4.00
Las Vegas1307648PREMIUM MOVIE07648130409 0.25 4.00
Las Vegas1307649PREMIUM MOVIE07649130528 0.25 4.00
Las Vegas1307649PREMIUM MOVIE07649130528 0.25 4.00
Las Vegas1307650PREMIUM MOVIE07650130521 0.25 4.00

<colgroup><col><col><col><col><col><col span="2"><col><col></colgroup><tbody>
</tbody>

<colgroup><col><col><col><col><col><col span="2"><col><col></colgroup><tbody>
</tbody>

<colgroup><col><col><col><col><col><col span="2"><col><col></colgroup><tbody>
</tbody>
 
Upvote 0
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.
 
Upvote 0
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:
Code:
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 Sub
Code:
Please help!
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,213,534
Messages
6,114,185
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