VBA to Automatically insert row based on cell text in current row (with partial data)

P

pstreet

New Member
Joined
Jan 16, 2018
Messages
5


Hi Guys, Sorry if this is an easy question, I'm a VBA beginner. This is a training tracker used within our team. Is there a module that;

automatically detects cell value "Did Not Attend" in column "J" and if TRUE - inserts a duplicated row below (without the cell data of "J" & "L:S")

Many Thanks in Advance! :p

SO THIS....
ABCDEFGHIJKLMNOPQRS
Employee ID NameJob TitleLocationBudget MonthActual MonthExpiry DateQualificationTrainerStart DateFinish Date if differentMonthStart TimeFinish TimeVenue
2017 BudgetEssentialInitialDAV Gavin DaviesOperativeNYC Asbestos AwarenessPearson Vue1 May08:0309:03Bolty
2017 BudgetEssentialRenewalDAV Gavin DOperativeNYC Did not attend07/09/2017National Water Hygiene SchemePearson Vue2 June08:0209:02Bolty
2017 BudgetEssentialRenewalDAV Gavin DOperativeNYC 07/09/2017National Water Hygiene SchemePearson Vue3 July08:0109:01Bolty
2017 BudgetEssentialInitialDAV Gavin DOperativeNYC Working at HeightsPearson Vue4 August08:0009:00Bolty
2017 BudgetEssentialInitialDAV Gavin DOperativeNYC March Confined Space Entry - City & GuildsRonnie Traiing9 July08:2817:02Skellon
Health and Safety TestEssentialInitialM_MUL Gavin MuiEstimatorWA Health and Safety testRonnie Traiing10 August08:2917:01Skellon
2017 BudgetEssentialInitialM_MUL Gavin MuiEstimatorWA June Temporary Works CoordinatorRonnie Traiing11 September08:3017:00Skellon
2017 BudgetEssentialInitialM_MUL Gavin MuiEstimatorWA CANDYPearson Vue2 June08:0209:02Bolty
2017 BudgetEssentialInitialM_MUL Gavin MuiEstimatorWA CSCS cardPearson Vue3 July08:0109:01Bolty
BECOMES...
Employee ID NameJob TitleLocationBudget MonthActual MonthExpiry DateQualificationTrainerStart DateFinish Date if differentMonthStart TimeFinish TimeVenue
2017 BudgetEssentialInitialDAV Gavin DaviesOperativeNYC Asbestos AwarenessPearson Vue1 May08:0309:03Bolty
2017 BudgetEssentialRenewalDAV Gavin DOperativeNYC Did not attend07/09/2017National Water Hygiene SchemePearson Vue2 June08:0209:02Bolty
2017 BudgetEssentialRenewalDAVGavin DOperativeNYC07/09/2017National Water Hygiene Scheme
2017 BudgetEssentialRenewalDAV Gavin DOperativeNYC 07/09/2017National Water Hygiene SchemePearson Vue4 August08:0009:00Bolty
2017 BudgetEssentialInitialDAV Gavin DOperativeNYC Working at HeightsRonnie Traiing9 July08:2817:02Skellon
2017 BudgetEssentialInitialDAV Gavin DOperativeNYC March Confined Space Entry - City & GuildsRonnie Traiing10 August08:2917:01Skellon
Health and Safety TestEssentialInitialM_MUL Gavin MuiEstimatorWA Health and Safety testRonnie Traiing11 September08:3017:00Skellon



<tbody>
</tbody><colgroup><col><col span="2"><col><col><col><col><col><col><col><col><col><col><col span="4"><col><col></colgroup>
 

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
Sort by date Sort by votes
Hi & welcome to the board.
Is this what you want?
Code: 
Sub InsertNewRow()

   Dim Fnd As Range
   Dim Qty As Long
   Dim Cnt As Long
   
   Set Fnd = Range("J1")
   With Columns(10)
      Qty = WorksheetFunction.CountIf(Columns(10), "Did not attend")
      For Cnt = 1 To Qty
         Set Fnd = .Find("Did not attend", Fnd, , xlWhole, , , False, , False)
         Fnd.Offset(1).EntireRow.Insert
         Fnd.Resize(2).EntireRow.FillDown
         Fnd.Offset(1).ClearContents
         Fnd.Offset(1, 3).Resize(, 7).ClearContents
      Next Cnt
   End With
End Sub
 
Upvote 0
Sorry this doesn't seem to work automatically in my full worksheet. :confused:

Could I combine it with the following VBA code, I would like it to insert a duplicate row below (only data in columns 1,2,3,4,5 & 6) within my worksheet.

Code: 
Private Sub Worksheet_Change1(ByVal Target As Range)
'Determine if change was made to a single cell in Column E
 If Target.Column = 5 And Target.Cells.Count = 1 Then
'Determine if Termed was chosen
  If Target = "Did not attend" Then
'If Yes...
''Disable Events
    Application.EnableEvents = False
'' Insert a row below
     ActiveCell.Offset(1).EntireRow.Insert
''Copy, Paste
      Rows(Target.Row).EntireRow.Copy _
       Destination:=Sheets("Non Attendance").Range("A" & nxtRw)
''Re-enable Events
    Application.EnableEvents = True
   
  End If
  End If
End Sub

Thanks so much!
 
Last edited by a moderator:
Upvote 0
In you op you said col J has "Did not attend" & to copy cols 1-9 & 11
Now the code you posted is col E & you say only copy cols 1-6

Which is correct?
 
Upvote 0
The worksheet was modified, (but now locked and won't change) so col E & cols 1-6 are required
 
Upvote 0
Untested but how about
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
'Determine if change was made to a single cell in Column E
   If Target.CountLarge > 1 Then Exit Sub
   If Target.Column = 5 Then
      'Determine if Termed was chosen
      If Target = "Did not attend" Then
      'If Yes...
      ''Disable Events
      Application.EnableEvents = False
      '' Insert a row below
      Target.Offset(1).EntireRow.Insert
      ''Copy, Paste
      Target.Offset(, -4).Resize(, 6).Copy Sheets("Non Attendance").Range("A" & Rows.Count).End(xlUp).Offset(1)
      ''Re-enable Events
      Application.EnableEvents = True
      
      End If
   End If
End Sub
 
Upvote 0
Glad to help & thanks for the feedback
 
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,215,268
Messages
6,123,970
Members
449,137
Latest member
yeti1016

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top