Insert new rows based on criteria in VBA

[Gutierrez]

Hello all ... need your help once again.

here is my problem ...

I have a worksheet with data in it .. in column"z" i have a number value ... what i would like to do .. is

1) insert a row after a certain criteria is met ie.

if column z row 1 = 20
row 2 = 20
row 3 =20
row 4 =30

i would want to insert a row between row 3 and 4

2) i would like to total the numbers above the column that i just inserted

so basically trying to do a grouping with totals.

any help would be appreciated.

 

[xlbo]

do you want to total whenever that number in column Z changes ??

If so, have a look at Data>Subtotals

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[Gutierrez]

no dont need totals ...

what i have in column z is a datediff in number of days ... so what i want to do .. is programatically insert a row where the number of days change ... for example .. first grouping would be 90 days or less ... second would be days between 91 and 365 and so forth ... so the worksheet is set up to list column z in ascending order ... so i just want to go to where the criteria = criteria 1 ... insert row ... then look for criteria 2 ... insert row .. and so forth ... must be done using VBA.

 

[xlbo]

so what have you tried ?

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[Gutierrez]

this is what i think will work .. just need some help figuring it all out ...


this is the range to be checked

need to set c = to find values that are >90 having trouble with that

and then want it to cycle through each cell in range when criteria is met then inser 3 rows above it with formatting (i think i can handle that part and then i can exit

i was thinking i could just run this code multiple times with different criteria

With newMonthData.Sheets("tempMonthData").Range("ay1:ay" & iLastRow)
Set c = .Find("Need this to be >90", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
formula to insert row here
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With

 

[xlbo]

If the data is sorted then there should be no need to use FIND

I would suggest that the easiest way is to initally use a VLOOKUP formula with the 4th argument set to TRUE to decide which group each line falls into. More info in the help files but basically, you set up an incrementing data table like:
0 Group1
90 Group2
365 Group3

formula would look like =vlookup(cell,LookupRange,2,TRUE)

use the formula to set a Group against each row
You can then use the SUBTOTAL function to insert subtotals based on changes in group

finally, remove the added column for cleanliness if you so desire

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[Gutierrez]

ok .. i follow u ... but how do i do a vlook up ... on a number ... and the lookup is not a number but a formula

in other words .. i am looking to make group1 all rows <90

how would u write the vlookup for that?

 

[xlbo]

as I suggested.

You have a lookup table:

0 group1
90 group2
365 group3
etc etc

when you use the lookup formula with a TRUE at the end, anything under 90 will return "group1", anything >90 but less than 365 will return "group2" and so on

you apply the formula to ALL your rows. This will give you data groupings. you then use the groupings to insert the subtotals

try setting up a lookup table as suggested and see what it gives you when you lookup different values into it....

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[firefytr]

How about an autofilter first? Then loop through your visible cells (if any)?

Regards,
Zack Barresse

Simplicity is the ultimate sophistication. What is a MS MVP? PODA
- Leonardo da Vinci

 

[Gutierrez]

Geoff ... ur idea to do a vlookup worked great .. thanks ... now i have no clue on how i would insert the subtotals ... what i would want ideally .. is to after change in grouping ... insert 3 row ... move everything down.

dont know if thats the proper way of doing it .. or working from the bottom up? any suggestions

 

[xlbo]

always work from the bottom up when inserting rows

shame that you need to insert 3 rows as Data>Subtotals would insert a row for you automatically

All you need to do is loop from bottom to top and test for a change in group value

eg - where your group text is in col E (or 5)

For i = lRow to 2 step -1
  if cells(i,5).text <> cells(i-1,5).value then
     'insert rows here
  else
  end if
next i

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[Gutierrez]

here is the code that i have .. and yes it does it automatically ... how do i incorporate your code to allow just the 3 rows to be added ... i dont need subtotals just yet


Dim iLastRow As Long
Dim vValue As Variant
Dim newMonthData As Workbook
Dim rg As Range

Set newMonthData = Workbooks.Open("q:\tempMonthData.xls", 3, , 2)

iLastRow = newMonthData.Sheets("tempMonthData").Range("A65536").End(xlUp).Row
sLookup = newMonthData.Sheets("tempMonthData").Range("A1") 'Brings back an entire "line" of data

Set rg = Intersect(ActiveSheet.[AZ:AZ], ActiveSheet.UsedRange.EntireRow)
' frmla = "VLOOKUP(tempmonthdata!RC51, " & PrevMonth.Worksheets("look").Range("A:CC").Address(ReferenceStyle:=xlR1C1, External:=True) & ",2, true)"
' frmla = "=IF(ISNA(" & frmla & "),0," & frmla & ")"
rg.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(1), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True 'Assign formula to range variable

newMonthData.Close True

 

[Gutierrez]

Hey Geoff ... got ur code to work .. just one question .. i want to add 3 rows not one .. how would i do that??

here is my code:


Dim i As Integer
Dim iLastRow As Long
Dim newMonthData As Workbook
Dim rg As Range

Set newMonthData = Workbooks.Open("q:\tempMonthData.xls", 3, , 2)

iLastRow = newMonthData.Sheets("tempMonthData").Range("A65536").End(xlUp).Row

For i = iLastRow To 2 Step -1
If Cells(i, 52).Text <> Cells(i - 1, 52).Value Then
Selection.Insert Shift:=xlDown 'insert rows here
Else
End If
Next i

 

[xlbo]

sorry - I'm a bit confused - why are you adding subtotals if you don't need 'em ?

If you just want to insert 3 lines then lose the subtotal code and put the loop in after you have done the formula, using the column you have just put the formula in to check for changes

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[Gutierrez]

i did change the code ... it just adds 1 line .. dont know how to change that to 3

 

[xlbo]

sorry - must've been typing whilst you posted

your code will not work unless you are selecting each row - which is a bad idea - try this:

For i = iLastRow To 2 Step -1
If Cells(i, 52).Text <> Cells(i - 1, 52).Value Then
Rows(i & ":" & i+2).Insert Shift:=xlDown


Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[Gutierrez]

ok .. that did work great ... but now i need the subtotals .. but for several different columns

here is what i have so far ... i would like to subtotal in the cell with the formatting .... all the cells in that group.

Dim i As Integer
Dim iLastRow As Long
Dim newMonthData As Workbook
Dim rg As Range

Set newMonthData = Workbooks.Open("q:\tempMonthData.xls", 3, , 2)

iLastRow = newMonthData.Sheets("tempMonthData").Range("A65536").End(xlUp).Row

For i = iLastRow To 2 Step -1
If Cells(i, 52).Text <> Cells(i - 1, 52).Value Then
Rows(i & ":" & i + 2).Insert Shift:=xlDown 'insert rows here
With ActiveSheet.Rows(i + 1 & ":" & i + 1)
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).Weight = xlThin
.Borders(xlEdgeTop).ColorIndex = xlAutomatic
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeBottom).ColorIndex = xlAutomatic
End With
Else
End If
Next i

 

[firefytr]

Couple of words of advice about your code...

NEVER use ActiveSheet
Check for the workbook being open before you open it
Fully qualify your range references to sheet & book
Dimension Long instead of Integer

HTH

Regards,
Zack Barresse

Simplicity is the ultimate sophistication. What is a MS MVP? PODA
- Leonardo da Vinci

 

[Gutierrez]

thanks firefytr .. i will keep that in mind

 

[Gutierrez]

ok .. that did work great ... but now i need the subtotals .. but for several different columns

here is what i have so far ... i would like to subtotal in the cell with the formatting .... all the cells in that group.

Dim i As Integer
Dim iLastRow As Long
Dim newMonthData As Workbook
Dim rg As Range

Set newMonthData = Workbooks.Open("q:\tempMonthData.xls", 3, , 2)

iLastRow = newMonthData.Sheets("tempMonthData").Range("A65536").End(xlUp).Row

For i = iLastRow To 2 Step -1
If Cells(i, 52).Text <> Cells(i - 1, 52).Value Then
Rows(i & ":" & i + 2).Insert Shift:=xlDown 'insert rows here
With ActiveSheet.Rows(i + 1 & ":" & i + 1)
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).Weight = xlThin
.Borders(xlEdgeTop).ColorIndex = xlAutomatic
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeBottom).ColorIndex = xlAutomatic
End With
Else
End If
Next i