PDA

View Full Version : [SOLVED] VBA to Insert Blank Row



nirvehex
02-13-2015, 07:40 AM
Hello all. This is cross posted here: http://www.mrexcel.com/forum/excel-questions/835867-visual-basic-applications-insert-blank-row.html

Here's the problem I'm trying to solve with VBA:

There are two columns I'm looking at: Column B and Column AA
Column B has a Location Code. Column AA has different strings of letters.

All I'm looking to do is: insert a blank row below the last row in the same group of location codes in column B if and only if there are only T's in column AA for the same row as that set of location codes. Or put another way, if the same group of location codes (column B) only show corresponding "T"'s in column AA then insert a blank row below the last location code in that like group.

So I think code needs to (1) identify how many rows the same location codes span, then (2) check column AA to see if there are only corresponding "T", then (3) if there are only T's corresponding, then insert a blank row below the last row in that same set of Location Codes, or (4) if there are not only T's corresponding, then do nothing and move to the next group of like Location Codes.

Here's an example of my spreadsheet:

Column B Column AA



Loc001
TV


Code would not insert blank row here because there is not only "T" in column AA for this location



Loc002
T


Loc002
T


Code inserts blank row here because there are only "T" in column AA for Loc002



Loc003
XRS


Code would not insert row here because there is not only "T" in column AA for Loc003



Loc004
T


Loc004
T


Loc004
T


Code inserts blank row here because there are only "T" in column AA for Loc004



Loc005
FFT


Code would not insert a blank here because there is not only "T" in column AA for Loc005



Loc006
T


Code inserts blank row here because there are only "T" in column AA for Loc006



Loc007
T


Code inserts blank row here because there are only "T" in column AA for Loc007



Loc008
T


Loc008
T


Loc008
XRT


Code would not insert blank row here because Loc008 does not have only "T"



Loc009
T


Code inserts blank row here because there are only "T" in column AA for this location



Loc010
FRT


Loc010
T


Code would not insert blank row here because Loc010 does not have only "T" in column AA for this location







Here's my code that almost works:


Dim i As Long

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual





For i = Range("B" & Rows.Count).End(3).Row To 2 Step -1
If Cells(i, "B") <> Cells(i + 1, "B") And Cells(i, "AA") = "T" Then
Rows(i + 1).Insert
End If
Next i





Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic


Any help would be so much appreciated! Thank you!

mancubus
02-13-2015, 11:15 AM
Sub insert_blank_rows_based_on_condition()

Dim Locs
Dim i As Long, RowInsNum As Long, calc As Long

With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
calc = .Calculation
.Calculation = xlCalculationManual
End With

With Worksheets("Sheet1") 'change Sheet1 to suit
.AutoFilterMode = False
.Cells(1).AutoFilter Field:=27, Criteria1:="=T"
.AutoFilter.Range.Columns(1).Offset(1).Copy .Cells(1, .Columns.Count)

With .Cells(1, .Columns.Count).CurrentRegion
.RemoveDuplicates Columns:=1, Header:=xlNo
Locs = .Value
.ClearContents
End With

For i = UBound(Locs, 1) To LBound(Locs, 1) Step -1
If Locs(i, 1) <> "" Then
.Cells(1).AutoFilter Field:=1, Criteria1:="=" & Locs(i, 1)
With .AutoFilter.Range.SpecialCells(xlCellTypeVisible)
RowInsNum = .Areas(.Areas.Count).Row + .Areas(.Areas.Count).Rows.Count
End With
Rows(RowInsNum).Insert
End If
Next i
.AutoFilterMode = False
End With

With Application
.EnableEvents = True
.Calculation = calc
End With

End Sub

mancubus
02-13-2015, 11:20 AM
.Areas(.Areas.Count).Row + .Areas(.Areas.Count).Rows.Count - 1

this bit gives the row number of last visible row of autofilter range.

we need to add 1 to this number in order to determine the row number to insert a blank row. so -1+1=0



credits go to WHO made it publicly available.

nirvehex
02-13-2015, 12:03 PM
Mancubus - Thank you for your help. Unfortunately the code errors out at .Cells(1).AutoFilter Field:=27, Criteria1:="=T" Says "AutoFilter method of Range class failed" Any ideas?

nirvehex
02-13-2015, 12:59 PM
Guys, this was just solved. Here's the code:



Sub insrtRow()
Dim X As Long, bCheck As Boolean, Y As Long


bCheck = False
Rows(1).EntireRow.Insert
For X = Range("B" & Rows.Count).End(xlUp).Row To 1 Step -1
If Not StrComp(Range("B" & X + 1).Value, Range("B" & X).Value, vbTextCompare) = 0 Then
If bCheck Then Range("B" & Y).EntireRow.Insert shift:=xlDown
Y = X + 1
bCheck = (Range("AA" & X).Value = "T")
Else
bCheck = (Range("AA" & X).Value = "T") And bCheck
End If
Next X
Rows(1).Delete
End Sub