Using Excel 97. I have a list of records that once sorted I want to be able
to do the following.
1). Find the first occurence of "1" in column U
2). Insert a row above
3). Select blank row from columns A:R
4). Shade cells
5). Place text in Column B of blank row.

Then find the first occurence of "2" in column U and proceed with steps 2
thru 5 above. Then proceed to find first occurence of "3" in column u and
proceed with steps 2 thru 5 above.
This is a process that will need to be done weekly so I would really like to
just run a macro to do the process. However, because I am working with a
list the number of rows will change weekly. The current code below generated
via the macro function uses specific row/column ranges, e.g. A137:R137. I
see the specific ranges in the code as a problem since the list will grow.
Can some help me revise the code so that when I run the macro there will not
be an issue? Thank you.

Sub Order()
Range("U2").Select
Cells.Find(What:="1", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate
Selection.EntireRow.Insert
Range("A3:r3").Select '(This will always be the first range)
Range("r3").Activate
With Selection.Interior
.ColorIndex = 41
.Pattern = xlSolid
End With
Selection.Font.ColorIndex = 2
Range("B3").Select
ActiveCell.FormulaR1C1 = "MIKE"
With ActiveCell.Characters(Start:=1, Length:=4).Font
.Name = "Arial"
.FontStyle = "Bold Italic"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 2
End With
Range("U2").Select
Cells.Find(What:="2", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate
Selection.EntireRow.Insert
Range("A118:r118").Select '(This will change when the list grows)
Range("r118").Activate
With Selection.Interior
.ColorIndex = 41
.Pattern = xlSolid
End With
Selection.Font.ColorIndex = 2
Range("r117").Select
Selection.Copy
Range("r118").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("B118").Select '(this won't always be the row)
ActiveCell.FormulaR1C1 = "MAM"
With ActiveCell.Characters(Start:=1, Length:=3).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 2
End With
Range("A118").Select
ActiveWindow.SelectedSheets.HPageBreaks.Add Befo=ActiveCell
Range("U2").Select
Cells.Find(What:="3", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate
Selection.EntireRow.Insert
Range("A133:r133").Select '(The row reference will change as the list
grows)
Range("r133").Activate
With Selection.Interior
.ColorIndex = 41
.Pattern = xlSolid
End With
Selection.Font.ColorIndex = 2
Range("r132").Select
Selection.Copy
Range("r133").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("B133").Select '(This too will not always be the row)
ActiveCell.FormulaR1C1 = "TO PRINTER"
With ActiveCell.Characters(Start:=1, Length:=10).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 2
End With
Range("A133").Select
ActiveWindow.SelectedSheets.HPageBreaks.Add Befo=ActiveCell
Range("U2").Select
Selection.AutoFilter Field:=21, Criteria1:="<4", Operator:=xlAnd
End Sub

Hi,


this should do it

Sub find123()
Dim y As Integer
For y = 1 To 3
[u1].Select
Do Until ActiveCell.Value = y
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.EntireRow.Select
Selection.Insert
x = ActiveCell.Row
Range("A" & x & ":" & "R" & x).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
Range("B" & x) = "Mike"
Next y
End Sub

somethinglikeant

Hi,

Unfortunately, I don't know VBA at all to revise the code you provided. I
can understand what one writes, but put me in front of the screen to do it
myself and I am at a loss. I guess, I didn't explain the entire process too
well.

Your code does part of what I need done, but not all. If you can, please
review the code that the record macro generated.

When it finds the number 2 and then 3 in column U, your code will insert a
blank row above 2 and 3 (as needed), but then it puts the same Text "Mike" in
column B.
When the text is insert for #1 it should be Mike (column B), for #2 it needs
to be "MAM" and for #3 it needs to be "To Printer".
In addition, a page break needs to be inserted above the blank row for 2 & 3.
Is it possible to do this? If yes, how?

TIA - Jan
"somethinglikeant" wrote:

Hi,


this should do it

Sub find123()
Dim y As Integer
For y = 1 To 3
[u1].Select
Do Until ActiveCell.Value = y
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.EntireRow.Select
Selection.Insert
x = ActiveCell.Row
Range("A" & x & ":" & "R" & x).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
Range("B" & x) = "Mike"
Next y
End Sub

somethinglikeant

Sub find123()
Dim y As Integer
For y = 1 To 3
[u1].Select
Do Until ActiveCell.Value = y
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.EntireRow.Select
Selection.Insert
x = ActiveCell.Row
Range("A" & x & ":" & "R" & x).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
If y 1 Then ActiveWindow.SelectedSheets.HPageBreaks.Add
Befo=ActiveCell
If y = 1 Then Range("B" & x) = "Mike"
If y = 2 Then Range("B" & x) = "MAM"
If y = 3 Then Range("B" & x) = "To Printer"
Next y
[A1].Select
End Sub

somethinglikeant

Try this.
It is a combination of your code (looks like a recorded macro) and
somethinglikeant's code.

I have tried to explain the steps, but if you need any clarification,
do not hesitate to post.

Option Explicit

Sub Order()
Dim intCounter As Integer
Dim dblActiveRow As Double

Cells(2, 21).Select 'does the same as your Range("U2").Select code
'Start the loop since you are looking for 1 or 2 or 3, you only
need to count from 1 to 3
For intCounter = 1 To 3
'This is the same code as your find, I just removed the
unnecessary prompts
Cells.Find(intCounter, ActiveCell, xlFormulas, xlWhole,
xlByColumns, xlNext, False, False).EntireRow.Select
'Insert the row
Selection.EntireRow.Insert
'You only want to add the color to columns A to R. so you need
to store the row number to define the range
dblActiveRow = ActiveCell.Row
'Select column "A" through "R" on the selected row (A = 1, R =
18)
Range(Cells(dblActiveRow, 1), Cells(dblActiveRow, 18)).Select
'Insert Page Break
ActiveSheet.HPageBreaks.Add Befo=ActiveCell
'Format the selection
With Selection
..Interior.ColorIndex = 41
..Font.ColorIndex = 2
..Font.Name = "Arial"
..Font.Bold = True
..Font.Italic = True
..Font.Size = 14
End With
'This decides which "header" goes with each search
Select Case intCounter
Case 1: Cells(dblActiveRow, 2) = "Mike"
Case 2: Cells(dblActiveRow, 2) = "MAM"
Case 3: Cells(dblActiveRow, 2) = "To Printer"
End Select
Next intCounter
'Make the columns only as wide as needed
Columns.AutoFit
'Make the rows only as tall as needed
Rows.AutoFit
End Sub


--
bgeier
------------------------------------------------------------------------
bgeier's Profile: http://www.excelforum.com/member.php...o&userid=12822
View this thread: http://www.excelforum.com/showthread...hreadid=541689

Thank you...thank you...Bgeier and somethinglikeant. I only wish I knew VBA
to accomplish so many of these type of tasks. While the "record macro" gets
one started it does have its draw backs for using the macro again when lists
are involved.

Jan

"bgeier" wrote:


Try this.
It is a combination of your code (looks like a recorded macro) and
somethinglikeant's code.

I have tried to explain the steps, but if you need any clarification,
do not hesitate to post.

Option Explicit

Sub Order()
Dim intCounter As Integer
Dim dblActiveRow As Double

Cells(2, 21).Select 'does the same as your Range("U2").Select code
'Start the loop since you are looking for 1 or 2 or 3, you only
need to count from 1 to 3
For intCounter = 1 To 3
'This is the same code as your find, I just removed the
unnecessary prompts
Cells.Find(intCounter, ActiveCell, xlFormulas, xlWhole,
xlByColumns, xlNext, False, False).EntireRow.Select
'Insert the row
Selection.EntireRow.Insert
'You only want to add the color to columns A to R. so you need
to store the row number to define the range
dblActiveRow = ActiveCell.Row
'Select column "A" through "R" on the selected row (A = 1, R =
18)
Range(Cells(dblActiveRow, 1), Cells(dblActiveRow, 18)).Select
'Insert Page Break
ActiveSheet.HPageBreaks.Add Befo=ActiveCell
'Format the selection
With Selection
.Interior.ColorIndex = 41
.Font.ColorIndex = 2
.Font.Name = "Arial"
.Font.Bold = True
.Font.Italic = True
.Font.Size = 14
End With
'This decides which "header" goes with each search
Select Case intCounter
Case 1: Cells(dblActiveRow, 2) = "Mike"
Case 2: Cells(dblActiveRow, 2) = "MAM"
Case 3: Cells(dblActiveRow, 2) = "To Printer"
End Select
Next intCounter
'Make the columns only as wide as needed
Columns.AutoFit
'Make the rows only as tall as needed
Rows.AutoFit
End Sub


--
bgeier
------------------------------------------------------------------------
bgeier's Profile: http://www.excelforum.com/member.php...o&userid=12822
View this thread: http://www.excelforum.com/showthread...hreadid=541689