VBA: Insert new row based on cell value & modify previous row

[laurie9300]

I've been a VBA hack for a few years now, and have always managed find and modify code as needed, and learn a little along the way, until now.

I'm doing a large amount of processing over 2 worksheets, and this last step has me confuddled. I have found some code that does each step, but cannot seem to marry them all together.

This processing needs to be done on "Sheet1"

There are 2 values involved and I need to step through all rows:

Date values in Column J
Labour minutes (integer) in Column Q

Each row needs to represent 1 workday of 426 minutes, but some jobs have more than 426 minutes allocated. I need to find and duplicate these rows modifying the labour minutes and date as I go.

If the value in Column Q < 426 - do nothing

If the value in Column Q > 426 - copy the row and paste it underneath - subtract 426 from the original row - in the new row Q = 426 and subtract 1 workday from J in the new row

Before:



After:



Adding new columns for the date or labour is not a problem, nor is the row order as the data is being referenced in another sheet.

Any help will be greatly appreciated..................

 

[JLGWhiz]

I had tested that using a different parameter and it worked, but after I posted it I made a last minute change and screwed it up. Here is a cleaned up and tested version that should do what you want without errors.

Sub t5()
With ActiveSheet
Dim rw As Long, v As Long, r As Integer, i As Long
    For rw = .Cells(Rows.Count, 17).End(xlUp).Row To 2 Step -1
        If .Cells(rw, 17).Value >= 426 Then
            v = Cells(rw, 17).Value
            If v Mod 426 > 0 Then
                r = Int(v / 426)
                .Cells(rw, 17).Offset(1).Resize(r).EntireRow.Insert
                .Range("A" & rw + 1).Resize(r, .UsedRange.Columns.Count) = .Range(.Cells(rw, 1), .Cells(rw, Columns.Count).End(xlToLeft)).Value
                .Cells(rw, 17).Offset(1).Resize(r) = 426
                .Cells(rw, 17) = v Mod 426
                For i = 1 To r
                    .Cells(rw, 17).Offset(i, -7) = .Cells(rw, 17).Offset(, -7).Value - i
                Next
            Else
                r = Int(v / 426)
                If r > 1 Then
                    .Cells(rw, 17).Offset(1).Resize(r - 1).EntireRow.Insert
                End If
                .Range("A" & rw + 1).Resize(r, .UsedRange.Columns.Count) = .Range(.Cells(rw, 1), .Cells(rw, Columns.Count).End(xlToLeft)).Value
                .Cells(rw, 17).Offset(1).Resize(r - 1) = 426
                .Cells(rw, 17) = 426
                For i = 1 To r
                    .Cells(rw, 17).Offset(i, -7) = .Cells(rw, 17).Offset(, -7).Value - i
                Next
            End If
        End If
    Next
    .Range("S2", .Cells(Rows.Count, 19).End(xlUp)).AutoFilter 1, "=#N/A"
    .Range("S2", .Cells(Rows.Count, 19).End(xlUp)).SpecialCells(xlCellTypeVisible).ClearContents
    .AutoFilterMode = False
End With
End Sub

You can play with it all you like. I am signing off and hitting the sack.

 

[laurie9300]

Thank You again JLGWhiz, this code works perfectly, and I even managed to get the WORKDAY function working.

I had to:
1. reference the Analysis Toolpack via Tools>References>check against atpvbaen.xls
2. Dim wf As WorksheetFunction
3. Set wf = Application.WorksheetFunction
4. Change your code from:

For i = 1 To r
    .Cells(rw, 17).Offset(i, -7) = .Cells(rw, 17).Offset(, -7).Value - i

To:

For i = 1 To r
    .Cells(rw, 17).Offset(i, -7) = wf.WorkDay(.Cells(rw, 17).Offset(, -7).Value, -i)

and the full code for reference.....

Sub TESTb2()
With ActiveSheet
Dim rw As Long, v As Long, r As Integer, i As Long, wf As WorksheetFunction
Set wf = Application.WorksheetFunction
    For rw = .Cells(Rows.Count, 17).End(xlUp).Row To 2 Step -1
        If .Cells(rw, 17).Value >= 426 Then
            v = Cells(rw, 17).Value
            If v Mod 426 > 0 Then
                r = Int(v / 426)
                .Cells(rw, 17).Offset(1).Resize(r).EntireRow.Insert
                .Range("A" & rw + 1).Resize(r, .UsedRange.Columns.Count) = .Range(.Cells(rw, 1), .Cells(rw, Columns.Count).End(xlToLeft)).Value
                .Cells(rw, 17).Offset(1).Resize(r) = 426
                .Cells(rw, 17) = v Mod 426
                For i = 1 To r
                    .Cells(rw, 17).Offset(i, -7) = wf.WorkDay(.Cells(rw, 17).Offset(, -7).Value, -i)
                Next
            Else
                r = Int(v / 426)
                If r > 1 Then
                    .Cells(rw, 17).Offset(1).Resize(r - 1).EntireRow.Insert
                End If
                .Range("A" & rw + 1).Resize(r, .UsedRange.Columns.Count) = .Range(.Cells(rw, 1), .Cells(rw, Columns.Count).End(xlToLeft)).Value
                .Cells(rw, 17).Offset(1).Resize(r - 1) = 426
                .Cells(rw, 17) = 426
                For i = 1 To r
                    .Cells(rw, 17).Offset(i, -7) = wf.WorkDay(.Cells(rw, 17).Offset(, -7).Value, -i)
                Next
            End If
        End If
    Next
    .Range("S2", .Cells(Rows.Count, 19).End(xlUp)).AutoFilter 1, "=#N/A"
    .Range("S2", .Cells(Rows.Count, 19).End(xlUp)).SpecialCells(xlCellTypeVisible).ClearContents
    .AutoFilterMode = False
End With
End Sub

 

[JLGWhiz]

Thank You again JLGWhiz, this code works perfectly, and I even managed to get the WORKDAY function working.

I had to:
1. reference the Analysis Toolpack via Tools>References>check against atpvbaen.xls
2. Dim wf As WorksheetFunction
3. Set wf = Application.WorksheetFunction
4. Change your code from:

For i = 1 To r
    .Cells(rw, 17).Offset(i, -7) = .Cells(rw, 17).Offset(, -7).Value - i

To:

For i = 1 To r
    .Cells(rw, 17).Offset(i, -7) = wf.WorkDay(.Cells(rw, 17).Offset(, -7).Value, -i)

and the full code for reference.....

Sub TESTb2()
With ActiveSheet
Dim rw As Long, v As Long, r As Integer, i As Long, wf As WorksheetFunction
Set wf = Application.WorksheetFunction
    For rw = .Cells(Rows.Count, 17).End(xlUp).Row To 2 Step -1
        If .Cells(rw, 17).Value >= 426 Then
            v = Cells(rw, 17).Value
            If v Mod 426 > 0 Then
                r = Int(v / 426)
                .Cells(rw, 17).Offset(1).Resize(r).EntireRow.Insert
                .Range("A" & rw + 1).Resize(r, .UsedRange.Columns.Count) = .Range(.Cells(rw, 1), .Cells(rw, Columns.Count).End(xlToLeft)).Value
                .Cells(rw, 17).Offset(1).Resize(r) = 426
                .Cells(rw, 17) = v Mod 426
                For i = 1 To r
                    .Cells(rw, 17).Offset(i, -7) = wf.WorkDay(.Cells(rw, 17).Offset(, -7).Value, -i)
                Next
            Else
                r = Int(v / 426)
                If r > 1 Then
                    .Cells(rw, 17).Offset(1).Resize(r - 1).EntireRow.Insert
                End If
                .Range("A" & rw + 1).Resize(r, .UsedRange.Columns.Count) = .Range(.Cells(rw, 1), .Cells(rw, Columns.Count).End(xlToLeft)).Value
                .Cells(rw, 17).Offset(1).Resize(r - 1) = 426
                .Cells(rw, 17) = 426
                For i = 1 To r
                    .Cells(rw, 17).Offset(i, -7) = wf.WorkDay(.Cells(rw, 17).Offset(, -7).Value, -i)
                Next
            End If
        End If
    Next
    .Range("S2", .Cells(Rows.Count, 19).End(xlUp)).AutoFilter 1, "=#N/A"
    .Range("S2", .Cells(Rows.Count, 19).End(xlUp)).SpecialCells(xlCellTypeVisible).ClearContents
    .AutoFilterMode = False
End With
End Sub

Thanks for the feed back.
regards, JLG