New Excel Forum

This forum has been moved to TeachExcel.com

Ask all future questions in the New Excel Forum.

ExcelKey

Insert a row based on text

Macros, VBA, Excel Automation, etc.

Insert a row based on text

Postby MikeLittle » Tue Feb 09, 2016 10:42 pm

I have a 1000 row spreadsheet that I work through daily, and need a method to insert a row based on the text found in column BD. I use vlookup to produce a status for an ordered part into column BD, but there isn't always a status, in which case the vlookup returns a "0" or "N/A". I need the macro to determine the text found in BD, and if there is text present that isn't a "0" or "N/A", then insert a row below directly below, and copy the text found in BD and paste it into the newly created row. Any cells in column BD that are blank, have a "0", or have "N/A", require no action.
  • 0

Last edited by MikeLittle on Thu Feb 11, 2016 10:31 pm, edited 1 time in total.
MikeLittle
Rookie
 
Posts: 4
Joined: Feb 9, 2016
Reputation: 0
Excel Version: pro 2016

Re: Insert a row based on text

Postby NoSparks » Wed Feb 10, 2016 1:19 am

Try this on a copy of your Orignal Report with vlookup in column BD.xls
It works on this file but merged cells can spell disaster when working in Excel.
I've colored the inserted rows for easy notice.
No need to change column BD from formulas, just use the .value

Code: Select all
Sub InsertSomeRows()
'ExcelKey -- Re: MikeLittle

    Dim lr As Long
    Dim i As Long
    Dim ws As Worksheet
   
Set ws = Sheets("Sheet1")

'speed up on
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

'find last used row on sheet
lr = ws.Cells.Find(what:="*", searchdirection:=xlPrevious, searchorder:=xlByRows).Row
For i = lr To 2 Step -1
    With ws.Cells(i, "BD")
        If Not IsError(.Value) Then
            If .Value <> "" And .Value <> 0 Then
                .Offset(1).EntireRow.Insert
                ws.Range("A" & i + 1).Value = .Value
                ws.Range("A" & i + 1 & ":BD" & i + 1).Interior.ColorIndex = 6
            End If
        End If
    End With
Next i

'speed up off
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

End Sub
  • 0

NoSparks
Excel Hobbyist
 
Posts: 637
Joined: May 28, 2014
Reputation: 103
Excel Version: 2010

Re: Insert a row based on text

Postby MikeLittle » Wed Feb 10, 2016 9:03 am

I have no experience with macros.... Do I copy all of that text, including the area where my name is? Where do I paste it?
  • 0

MikeLittle
Rookie
 
Posts: 4
Joined: Feb 9, 2016
Reputation: 0
Excel Version: pro 2016


Re: Insert a row based on text

Postby MikeLittle » Wed Feb 10, 2016 10:59 am

Wow, amazing. That spurs more questions for me. I found where you added the highlight color, and changed it to 0 to make them white. The system that this report comes out of creates a horribly formatted report, it ends up with different row heights and different cells merged, so I have a couple issues to figure out.

First, can the row height be consistent at 12.75? on the attachment, they format as the row above, so row 48 is good, but row 70 is too short.

Second, the same rows that are too short, also make the cell in column H and I (with the string of 9 numbers) merge with the two rows below it, so when the note is moved under that cell, the note is cut off, example row 105. Sometimes the note is short enough to fit, but when the note is more detailed, it doesn't show it unless I manually go through and unmerge that cell.

Finally, how would I add code to make the notes a different text color?

Thanks so much for all the help, I can't believe the time this is going to save me at work!!!
  • 0

Last edited by MikeLittle on Thu Feb 11, 2016 10:31 pm, edited 1 time in total.
MikeLittle
Rookie
 
Posts: 4
Joined: Feb 9, 2016
Reputation: 0
Excel Version: pro 2016

Re: Insert a row based on text

Postby NoSparks » Wed Feb 10, 2016 12:52 pm

I found where you added the highlight color, and changed it to 0 to make them white.

just remove the line, was only put in so I could quickly see what happened and where.
You did notice the voids in the highlighting of those rows? Those were cells the code couldn't touch due to them being merged.

Merged cells are the work of the Devil and should be avoided like the plague.
Have added a line of code that may or may not work, maybe some of the time, maybe all of the time.

Code: Select all
Sub InsertSomeRows()

    Dim lr As Long
    Dim i As Long
    Dim ws As Worksheet
   
Set ws = Sheets("Sheet1")

'speed up on
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

'find last used row on sheet
lr = ws.Cells.Find(what:="*", searchdirection:=xlPrevious, searchorder:=xlByRows).Row
For i = lr To 2 Step -1
    With ws.Cells(i, "BD")
        If Not IsError(.Value) Then
            If .Value <> "" And .Value <> 0 Then
                .Offset(1).EntireRow.Insert
                ws.Range("A" & i + 1 & ":BD" & i + 1).Cells.UnMerge
                ws.Range("A" & i + 1).RowHeight = 12.75
                ws.Range("A" & i + 1).Value = .Value
            End If
        End If
    End With
Next i

'speed up off
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

Good Luck
  • 1

NoSparks
Excel Hobbyist
 
Posts: 637
Joined: May 28, 2014
Reputation: 103
Excel Version: 2010

Re: Insert a row based on text

Postby pecoflyer » Wed Feb 10, 2016 2:37 pm

Merged cells are the work of the Devil and should be avoided like the plague.


+1
  • 0

A relevant topic title helps get faster and more answers
pecoflyer
Moderator
 
Posts: 1274
Joined: Jan 24, 2012
Location: Belgium
Reputation: 39
Excel Version: 2003/2007/2010

Re: Insert a row based on text

Postby NoSparks » Wed Feb 10, 2016 2:47 pm

:oops: :oops: Can't take credit for that.
Stole it from somebody's tag line. :oops: :oops:

does that mean I have to give the point back ? ;)
  • 0

NoSparks
Excel Hobbyist
 
Posts: 637
Joined: May 28, 2014
Reputation: 103
Excel Version: 2010

Re: Insert a row based on text

Postby MikeLittle » Thu Feb 11, 2016 9:22 am

The unmerging task works too well... I need it to unmerge the cells under columns 'H' and 'I', only the two cells that have the 9 digit number in them. The way its written right now, it unmerges the whole row above the inserted row, but that causes some other data to be lost. IF there is w way to change the unmerge task, to only unmerge the cell with th e9 digit numerical value, and only the ones that are found above a row previously inserted by this macro, that would be ideal.

Thank you so much for all the help.


Code: Select all
Sub Allthreemacros()


    Range("AR23:AU23").Select
    Columns("AU:AU").ColumnWidth = 3.71
    Range("AD19:AG19").Select
    Columns("AG:AG").ColumnWidth = 4.43
    Range("BD22").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-31],'Sheet1 (2)'!C[-31]:C,32,0)"
    Range("BD22").Select
    Selection.Copy
    Range("BD23:BD850").Select
    ActiveSheet.Paste
    Columns("BD:BD").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      BInsertSomeRows
End Sub

Sub BInsertSomeRows()

    Dim lr As Long
    Dim i As Long
    Dim ws As Worksheet
   
Set ws = Sheets("Sheet1")

'speed up on
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

'find last used row on sheet
lr = ws.Cells.Find(what:="*", searchdirection:=xlPrevious, searchorder:=xlByRows).Row
For i = lr To 2 Step -1
    With ws.Cells(i, "BD")
        If Not IsError(.Value) Then
            If .Value <> "" And .Value <> 0 Then
                .Offset(1).EntireRow.Insert
                ws.Range("A" & i + 1 & ":BD" & i + 1).Cells.UnMerge
                ws.Range("A" & i + 1).RowHeight = 12.75
                ws.Range("A" & i + 1).Value = .Value
                ws.Range("A" & i + 1 & ":BD" & i + 1).Font.Color = vbRed
            End If
        End If
    End With
Next i

'speed up off
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
CDeletes

End Sub

Sub CDeletes()
'
' Deletes Macro
'

'
    Selection.Delete Shift:=xlToLeft
    Sheets("Sheet1 (2)").Select
    ActiveWindow.SelectedSheets.Delete
End Sub
  • 0

Last edited by MikeLittle on Fri Feb 12, 2016 9:58 am, edited 1 time in total.
MikeLittle
Rookie
 
Posts: 4
Joined: Feb 9, 2016
Reputation: 0
Excel Version: pro 2016

Re: Insert a row based on text

Postby NoSparks » Thu Feb 11, 2016 11:41 am

The way its written right now, it unmerges the whole row above the inserted row

No it doesn't. Take a look at rows 47 and 49, rows 48 and 50 are inserted and none of the merged cells of 47 or 49 are unmerged.

Having said that, I suspect your unmerging observation is (partially) correct when the inserted row is between rows that have cells merged vertically and I suspect the content of that merge aren't lost but will now all be in the upper left cell of the original merge.

So, how do you deal with that?
Don't know, I'm afraid I have no idea what the code required would be.

Merged cells are great for the cosmetic appearance of Excel but pure hell when dealing with the data.
  • 0

NoSparks
Excel Hobbyist
 
Posts: 637
Joined: May 28, 2014
Reputation: 103
Excel Version: 2010

Next

Return to Macros and VBA Questions

Who is online

Users browsing this forum: No registered users and 47 guests

cron