VBA: Copy multiple cells if Specific Text in row, then modify

siddowens123

New Member
Joined
Mar 7, 2012
Messages
3
Hey All, Brand new to this forum! Looks very promising though.

I checked and couldn't find code that dealt with these types of issues:confused:, so here goes...

I want some VBA code that will:

1) automatically check the active row to see if it contains specific text (i dont' care if there is other stuff in the cell or cells), such as "truck 1 blahblahblah" and checks for specific font color, such as green.

2) if the row does, then I want it to copy ALL the cells in the active row EXCEPT Column A (which contains the date), and then paste them twice, one 21 rows down from the active row, and one 35 rows down from the active row.

3) Once copied and pasted, modify the pasted cells slightly. The first pasted cells need to say Truck 2 blahblahblah in Column C and be in blue font (instead of the original Truck 1 blahblahblah in Green Font), the second needs to say Truck 3 blahblahblah and be in yellow font. Everything else that was pasted will be the same EXCEPT they will be in blue or yellow font.


If you can figure out how to do those things, or even one of them, I will bow down to you like darth vader does to emperor palpatine~:)

Cheers,
Sidd Owens
 

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.
I forgot to show the code i have so far, which isn't much at all.

Sub CheckActiveRow(ByVal Target As Range) 'This routine checks the active row (the current row you are typing in) to see if it contains the desired text "Truck 1 Trellis & Interior" and desired font color (Green). If it does, then it will call (activate) the subroutine CopyAndPasteRow().


Application.EnableEvents = True
If ActiveRow.Text = "Truck 1 Trellis & Interior" Then 'The cell may have other strings of characters in it, but we are checking to see if the text "Truck 1 Trellis & Interior" is in it, we want it to give us a hit regardless if there is extra stuff in the cell besides "Truck 1 Trellis & Interior".
CopyAndPasteRow()

End Sub

Sub CopyAndPasteRow() 'This routine copies Columns B,C,D,E, and F (NOT COLUMN A THOUGH, OTHERWISE THE DATE OF SHIPMENT WILL BE CHANGED) in the same row as the active row, and pastes them into 2 different locations, one which is 21 rows down from the active cells row, the next 35 rows down from active cells row (this pastes the active row 3 weeks after and 5 weeks after). After it has copied the cells, it calls on subroutine ModifyFirstPastedCells()



ModifyFirstPastedCells()



End Sub

Sub ModifyFirstPastedCells() ' This routine changes the cells that were pasted 21 rows down from active row slightly. First it changes the font color (from green to blue), then it changes the text in Column C to say "Truck 2 Trim & Beams" instead of "Truck 1 Trellis & Interior" After modifying, it calls on ModifySecondPastedCells()

ModifySecondPastedCells()

End Sub

Sub ModifySecondPastedCells() ' This routine changes the cells that were pasted 35 rows down from active row slightly. First it changes the font color (from green to yellow), then it changes the text in Column C to say "Truck 3 Cabinets" instead of "Truck 1 Trellis & Interior"



End Sub
 
Upvote 0
Here is the updated code (sorry it took so long!), but I keep getting runtime errors (438) in excel 2007. The problem is it does not highlight the bad code when i go into debug mode. Not sure if the syntax I am using is out of date?

Public Sub CheckActiveCell() 'This routine checks the active cell (in the current row you are typing in) to see if it contains the desired text "Truck 1 Trellis & Interior" and desired font color (Green).
'If it does, then it will call (activate) the subroutine CopyAndPasteRow()

Application.EnableEvents = True
If ActiveCell.Value = "Truck 1 Trellis & Interior" Then 'The cell may have other strings of characters in it, but we are checking to see if the text "Truck 1 Trellis & Interior" is in it, we want it to give us a hit regardless if there is extra stuff in the cell besides "Truck 1 Trellis & Interior".
End If

Call CopyAndPasteRow

End Sub

Sub CopyAndPasteRow() 'This routine copies Columns B,C,D,E, and F (NOT COLUMN A THOUGH, OTHERWISE THE DATE OF SHIPMENT WILL BE CHANGED) in the same row as the active row, and pastes them into 2 different locations, one which is 21 rows down from the active cells row, the next 35 rows down from active cells row (this pastes the active row 3 weeks after and 5 weeks after).
'After it has copied the cells, it calls on subroutine ModifyFirstPastedCells()

NextRow = Worksheets("Sheet1").ActiveCell.Row + 21

Cells(ActiveCell.Row, 1).Resize(2, 6).Copy _
Destination:=NextRow

Call ModifyFirstPastedCells

End Sub
Public Sub CopyAndPasteSecondRow()

SecondRow = Worksheets("Sheet1").ActiveCell.Row + 14

Cells(ActiceCell.Row, 1).Resize(2, 6).Copy _
Destination:=SecondRow

Call ModifySecondPastedCells


End Sub
Public Sub ModifyFirstPastedCells() ' This routine changes the cells that were pasted 35 rows down from active row slightly. First it changes the font color (from green to yellow), then it changes the text in Column C to say "Truck 2 Trim & Beams" instead of "Truck 1 Trellis & Interior"
' After modifying, it calls on ModifyFirstPastedCells()

If Cells(ActiveCell.Row, 3).Value = "Truck 1 Trellis & Interior" Then

Cells(ActiveCell.Row, 3).Value = "Truck 2 Trim & Beams"
Cells(ActiveCell.Row, 6).Font.Color = vbBlue

Call CopyAndPasteSecondRow


End If


End Sub
Public Sub ModifySecondPastedCells() ' This routine changes the cells that were pasted 21 rows down from active row slightly. First it changes the font color (from green to blue), then it changes the text in Column C to say "Truck 3 Cabinets" instead of "Truck 1 Trellis & Interior"

If Cells(ActiveCell.Row, 3).Value = "Truck 1 Trellis & Interior" Then

Cells(ActiveCell.Row, 3).Value = "Truck 3 Cabinets"
Cells(ActiveCell.Row, 6).Font.Color = vbYellow

End If

End Sub



Any ideas?
 
Upvote 0

Forum statistics

Threads
1,223,270
Messages
6,171,102
Members
452,379
Latest member
IainTru

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