Macro to find substring, insert row, move text from adjacent cell to new (SOLVED)

Royzer · Jun 19th 2013

I could really use some help. I need a macro that will look for the word "Station" at the beginning of each cell in column A and insert a row beneath it when it is found, then move the Account Type text from the adjacent cell in column B to the new row, in column A.

The report will vary in length each month, so the macro needs to find the bottom of the data each time to make sure nothing is missed

I've attached a file forum.ozgrid.com/index.php?attachment/54380/ with before and after examples. Thanks so much!

Oracle2057 · Jun 19th 2013

Re: Macro to find substring, insert row, move text from adjacent cell to new row

Hello,

The attached file contains a macro that should work for you. Also the code for the macro is below. Just change the reference to the Sheet name when you copy into your spreadsheet and you should be good to go. Please let me know if you were looking for something different.

[ATTACH=CONFIG]54383[/ATTACH]

VBA:

Code

Public Sub FindStation()
Dim strWordToFind As String, strSheetProcess As String
Dim lngCounter As Long, lngLastCell As Long, lngStartCell As Long
lngLastCell = Selection.SpecialCells(xlCellTypeLastCell).Row
lngStartCell = 2
strWordToFind = "station"
strSheetProcess = "TestPage"
For lngCounter = lngStartCell To lngLastCell
    If InStr(LCase(Sheets(strSheetProcess).Range("A" & lngCounter)), strWordToFind) > 0 Then
        Sheets(strSheetProcess).Rows(lngCounter + 1).Insert shift:=xlDown
        Sheets(strSheetProcess).Range("B" & lngCounter).Cut Sheets(strSheetProcess).Range("A" & lngCounter + 1)
        lngCounter = lngCounter + 1
    End If
Next
End Sub

Display More

Royzer · Jun 20th 2013

Re: Macro to find substring, insert row, move text from adjacent cell to new row

Thank you, Oracle2057. This code is doing exactly what I needed it to do, except it is stopping short of the last section or so when I use multiple stations. I've tried different numbers of stations (like my data will be), but for some reason it stops short. There is an example in the file you sent me (attached, but renamed.)

forum.ozgrid.com/index.php?attachment/54392/

Thanks again!

jindon · Jun 20th 2013

Re: Macro to find substring, insert row, move text from adjacent cell to new row

Try this

Code

Sub test()
    Dim r As Range, ff As String
    With Columns(1)
        Set r = .Find("station*", .Cells(.Cells.Count), , 1)
        If Not r Is Nothing Then
            ff = r.Address
            Do
                If r(, 2).Value <> "" Then
                    r(2).EntireRow.Insert
                    r(, 2).Cut r(2)
                End If
                Set r = .FindNext(r)
            Loop Until ff = r.Address
        End If
    End With
End Sub

Display More

Royzer · Jun 20th 2013

Re: Macro to find substring, insert row, move text from adjacent cell to new row

It looks like that did the trick, Jindon. I really appreciate the time both you and Oracle2057 spent trying to help me. You guys are both awesome! :rock:

Royzer · Jun 20th 2013

Re: Macro to find substring, insert row, move text from adjacent cell to row (SOLVED)

Added this comment before I realized I could put (solved) in the main header.

Macro to find substring, insert row, move text from adjacent cell to new (SOLVED)

Participate now!

Share