PDA

View Full Version : Solved: Inserting rows after highlighting a cell



colindickson
11-08-2012, 05:46 AM
Hi,

I've been given this VBA to highlight new database codes added to a list... I also want it to add move the cells to right down, if that makes sense.

I've attached a before and after example.

Private Sub CommandButton2_Click()
Range("E5").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
LRA = Cells(Rows.Count, "D").End(xlUp).Row
LRB = Cells(Rows.Count, "E").End(xlUp).Row
j = 3 '
For i = 3 To LRB
comp = Application.Match(Range("e" & i), Range("D3:D" & LRA), 0)
If IsError(comp) Then Range("e" & i).Interior.ColorIndex = 6
Next i

End With

End Sub

xld
11-08-2012, 04:47 PM
Where is this new code coming from? Shouldn't A14 shift down as well?

colindickson
11-08-2012, 11:57 PM
The data in column A remains static and a download of new codes is dumped into column B from an external source (using an excel add-in).

I hope that helps.

xld
11-09-2012, 06:06 AM
Sub ProcessData()
Dim rng As Range
Dim lastrow As Long
Dim startrow As Long
Dim i As Long

Application.ScreenUpdating = False

With ActiveSheet

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
startrow = 2
Do

For i = startrow To lastrow

If .Cells(i, "A").Value > .Cells(i, "B").Value Then

.Cells(i, "C").Resize(, 8).Insert shift:=xlDown
.Cells(i, "A").Insert shift:=xlDown
startrow = i + 1
Exit For
End If
Next i
Loop Until i > lastrow

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = .Range("A2").Resize(lastrow - 1)
On Error Resume Next
Set rng = rng.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not rng Is Nothing Then rng.Delete shift:=xlUp
End With

Application.ScreenUpdating = True
End Sub

colindickson
11-12-2012, 03:29 AM
This works like a dream thanks very much!!!

The only issue I have with this, is that if there's no new codes added to column B then it completely wipes out colemn A... is there any way just to ignore the whole process if there's no new codes been added to column B?

Thanks in advance.

xld
11-12-2012, 03:48 AM
This should sort that issue

Sub ProcessData()
Dim rng As Range
Dim lastrow As Long
Dim startrow As Long
Dim i As Long

Application.ScreenUpdating = False

With ActiveSheet

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
startrow = 2
Do

For i = startrow To lastrow

If .Cells(i, "A").Value > .Cells(i, "B").Value Then

.Cells(i, "C").Resize(, 8).Insert shift:=xlDown
.Cells(i, "A").Insert shift:=xlDown
startrow = i + 1
Exit For
End If
Next i
Loop Until i > lastrow

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = .Range("A2").Resize(lastrow - 1)
On Error Resume Next
Set rng = rng.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not rng Is Nothing And Application.CountIf(rng, "") > 0 Then rng.Delete shift:=xlUp
End With

Application.ScreenUpdating = True
End Sub

colindickson
11-12-2012, 05:53 AM
Genius - great work.

Thanks again!!!