Need a macro to search my spreadsheet and add values.

gocom1ok

New Member
Joined
Jul 28, 2007
Messages
4
I have a spreadsheet that will contain about 2000 rows to it and I need to be able to search all of the rows and add data according to certain criteria. For instance I need to search cells A95:C2000, looking for the following in column A: VA, AT, CT, AC. I then need to add a row right under where the previous entry was located along with highlighting the “C” cell associated with the “A” cell. The row that needs to be added needs to contain HS in the “A” cell, a copy of the “B” cell, and a different cell color, like red for the “C” cell. Please help. I will email you a copy of my spreadsheet. Thanks.
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

VoG

Legend
Joined
Jun 19, 2002
Messages
63,650
I think that you need to look at the help for Conditional Formating.

You cannot add a row using a formula.
 

gocom1ok

New Member
Joined
Jul 28, 2007
Messages
4
Sorry if I didn't make myself clear, I'm not trying to use a formula, I want to use a macro. I try to record one, but I don't know enough about them to edit it so it will look for the criteria, not the specified cells that are used in the recorded macro. Also, I have both Excel 2003 and 2007, if anyone knows how to do this in either, it would be very appreciated. Thanks.
 

Gives

Board Regular
Joined
Aug 22, 2006
Messages
160
Try This Macro

Not exactly sure what you want to do but see if the macro below is close enough:

Sub ScanWS()
Dim lastRow As Long
lastRow = ActiveSheet.UsedRange.Rows.Count
Cells(1, 1).Select
Do
If InStr(ActiveCell.Value, "VA") > 0 Or InStr(ActiveCell.Value, "AT") > 0 Or InStr(ActiveCell.Value, "CT") > 0 Or InStr(ActiveCell.Value, "AC") > 0 Then
ActiveCell.Offset(1, 0).Select
Selection.EntireRow.Insert
Cells(ActiveCell.Row, 1) = "BC"
Cells(ActiveCell.Row, 2) = Cells(ActiveCell.Row - 1, 2)
With Cells(ActiveCell.Row, 3).Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
lastRow = lastRow + 1
End If
ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell.Row > lastRow
End Sub
 

gocom1ok

New Member
Joined
Jul 28, 2007
Messages
4
I had to edit it slightly, but this is exactly what I need. Thank you very much. I was wondering if there was one more thing I could have done to it, which I can't figure out. After the "C" column is changed to red, I have column's "D-K" merged. Is there a way to add this to the macro to get it to merge those columns after it turns the "C" field red? Thanks again for your help.

Below is the macro with some minor changes to make it work for my spreadsheet:


Sub ScanWS()
Dim lastRow As Long
lastRow = ActiveSheet.UsedRange.Rows.Count
Cells(95, 1).Select
Do
If InStr(ActiveCell.Value, "VA") > 0 Or InStr(ActiveCell.Value, "AT") > 0 Or InStr(ActiveCell.Value, "CT") > 0 Or InStr(ActiveCell.Value, "AC") > 0 Then
ActiveCell.Offset(1, 0).Select
Selection.EntireRow.Insert
Cells(ActiveCell.Row, 1) = "HS"
Cells(ActiveCell.Row, 2) = Cells(ActiveCell.Row - 1, 2)
With Cells(ActiveCell.Row, 3).Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
lastRow = lastRow + 1
End If
ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell.Row > lastRow
End Sub
 

Gives

Board Regular
Joined
Aug 22, 2006
Messages
160
To merge cells D-K on the new inserted row add the following statements right after the last End With statement above (Warning - if more than one cell contains data in the cells to be merged, only the data in the leftmost cell will be retained.):

With Range(Cells(ActiveCell.Row, 4), Cells(ActiveCell.Row, 11))
.MergeCells = True
End With
 

gocom1ok

New Member
Joined
Jul 28, 2007
Messages
4
Everything works Great now. Thank you very much for your help. Hope you have a great day.
 

Forum statistics

Threads
1,181,407
Messages
5,929,766
Members
436,687
Latest member
Glass of Gin

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
Top