vba to insert copied row below row of a specific value

DRWonoski

Board Regular
Joined
Mar 20, 2014
Messages
99
I'm new to VBA but trying to learn and wrap my head around the way vba works. What I need can be seen below:

Formula1Formula2Formula3Formula41234Step1Step2Step3DOGComplete
Formula1Formula2Formula3Formula45678Step1Step2DOG
Formula1Formula2Formula3Formula44321Step1Step2DOG
Formula1Formula2Formula3Formula48765Step1DOG
Formula1Formula2Formula3Formula42468Step1Step2Step3CATComplete
Formula1Formula2Formula3Formula41359Step1Step2CAT
Formula1Formula2Formula3Formula48642Step1CAT

<tbody>
</tbody>


This table represents a status of open orders in a spreadsheet. I'd like to create a button that when clicked, finds the last occurrence of "Cat" or "Dog" (which I will tell it), copy the last row of that occurrence, and paste it as a new row below the last. Note: the blank row inbetween DOG and CAT is important and must stay. I'd also like it to copy the formulas from Cells 1-4.

How best would you do set up the vba? My thought is to do these steps in this order:
1) inputBox pops up for the user to enter the PO number (1234, 4321 found above).
2) find last occurrence of Dog
3) Copy row of last occurrence of dog
4) Insert Copied cells from step above
5) if "Step2, Step3 or "Complete" are filled in, make those cells blank.

These are the steps I would take if I were manually adding a new row but I feel like VBA may have some ways to accomplish it without all of those steps needed.
 

Some videos you may like

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.

RCBricker

Well-known Member
Joined
Feb 4, 2003
Messages
1,560
I'm new to VBA but trying to learn and wrap my head around the way vba works. What I need can be seen below:

Formula1Formula2Formula3Formula41234Step1Step2Step3DOGComplete
Formula1Formula2Formula3Formula45678Step1Step2DOG
Formula1Formula2Formula3Formula44321Step1Step2DOG
Formula1Formula2Formula3Formula48765Step1DOG
Formula1Formula2Formula3Formula42468Step1Step2Step3CATComplete
Formula1Formula2Formula3Formula41359Step1Step2CAT
Formula1Formula2Formula3Formula48642Step1CAT

<tbody>
</tbody>


This table represents a status of open orders in a spreadsheet. I'd like to create a button that when clicked, finds the last occurrence of "Cat" or "Dog" (which I will tell it), copy the last row of that occurrence, and paste it as a new row below the last. Note: the blank row inbetween DOG and CAT is important and must stay. I'd also like it to copy the formulas from Cells 1-4.

How best would you do set up the vba? My thought is to do these steps in this order:
1) inputBox pops up for the user to enter the PO number (1234, 4321 found above).
2) find last occurrence of Dog
3) Copy row of last occurrence of dog
4) Insert Copied cells from step above
5) if "Step2, Step3 or "Complete" are filled in, make those cells blank.

These are the steps I would take if I were manually adding a new row but I feel like VBA may have some ways to accomplish it without all of those steps needed.


try this

Code:
Sub DRWonoski()

Dim wb As Workbook
Dim ws As Worksheet
Dim lngrow As Long, lngcol As Long
Dim rng As Range, rngFIND As Range, rngCOPY As Range
Dim strRNG As Variant
Dim intPO As Integer, intITEM As Integer, intST2 As Integer, intST3 As Integer, intSTA As Integer, intROW As Integer
Dim i As Variant, j As Variant

    Set wb = ThisWorkbook
    Set ws = ActiveSheet
    Set rng = Application.InputBox(Prompt:="Please select the PO column header cell.", Type:=8)
    intPO = rng.Column
    intST2 = intPO + 2
    intST3 = intPO + 3
    intITEM = intPO + 4
    intSTA = intPO + 5
    strRNG = InputBox("Please enter the PO number.", "PO Number")
    With ws
        lngrow = ws.Cells(ws.Rows.Count, rng.Column).End(xlUp).Row
        lngcol = ws.Cells(rng.Row, ws.Columns.Count).End(xlToLeft).Column
        Set rngFIND = ws.Range(ws.Cells(rng.Row, rng.Column), ws.Cells(lngrow, rng.Column))
        intROW = rngFIND.Find(strRNG).Row
        strRNG = ws.Cells(intROW, intITEM).Value
        
        For i = lngrow To rng.Row Step -1
            If CStr(ws.Cells(i, intITEM).Value) = strRNG Then
                j = i + 1
                Set rngCOPY = ws.Cells(i, intITEM).EntireRow
                rngCOPY.EntireRow.Copy
                ws.Rows(i & ":" & i).Insert shift:=xlDown
                ws.Cells(j, intST2).Value = ""
                ws.Cells(j, intST3).Value = ""
                ws.Cells(j, intSTA).Value = ""
                Exit For
            End If
        Next
    End With
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,118,850
Messages
5,574,650
Members
412,607
Latest member
caner
Top