(Solved) – VBA coding help to lookup values of items, copy them and paste them in another worksheet along with adding rows

(solved)-–-vba-coding-help-to-lookup-values-of-items,-copy-them-and-paste-them-in-another-worksheet-along-with-adding-rows

Hi I am fairly new to VBA coding. I am looking to create a VBA which does the following:

  1. It copies task numbers from column A in sheet 1 to column A in sheet 2
  2. If that task has a corresponding amount in Column M in sheet 1 it copies that amount in sheet in sheet2
  3. If the task has 5, 10 or even 20 sub tasks in sheet 1, it should add that many rows (not the data, just rows) in sheet 2 before inserting a total column.

So far I have this code written up and its functioning. It finds my task numbers in sheet 1, it finds the corresponding amounts and also pastes their values in sheet 2. Only problem is that it is only adding 5 rows in sheet 2 instead of the total number of rows that my task contains in sheet 1.

If anyone here can give me some advice on how i can edit the code below to ensure that my VBA is adding enough rows in sheet 2 that would be very helpful!

    Option Explicit

Sub Update_Asset_Information()

Dim Range_Alpha As Range
Dim Range_Bravo As Range
Dim Range_Charlie As Range
Dim Range_Delta As Range
Dim Cell_Alpha As Range
Dim Cell_Bravo As Range
Dim Cell_Charlie As Range
Dim Cell_Delta As Range
Dim WS As Worksheet

Dim FirstRow As Long
Dim LastRow As Long
Dim FinalRow As Long
Dim RowCount As Long
Dim RowsToInsert As Long
Dim i As Long
Dim r As Long

FirstRow = 2
RowCount = 1
RowsToInsert = 5



'//////Disable application functions to speed up VBA runtime

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Application.AskToUpdateLinks = False

'//////Clear cell contents and formatting

Worksheets("Asset Information").Activate
Range("A8:P1000").Select
    Selection.FormatConditions.Delete
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.ClearContents
    Selection.Interior.ColorIndex = 2

With Range("D8:D1000").Validation
.Delete

End With

With Range("E8:E1000").Validation
.Delete

End With

Worksheets("Scratch Paper").Visible = True
Worksheets("Tables").Visible = True
Worksheets("Scratch Paper").Activate
Range("A2:A1000").Select
    Selection.FormatConditions.Delete
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.ClearContents
    Selection.Interior.ColorIndex = 2

'/////Copy Task Numbers to Scratch Paper//////
On Error Resume Next
Set Range_Alpha = Application.Worksheets("Estimate").Range("A8:A1000")
Set Range_Bravo = Application.Worksheets("Scratch Paper").Range("A2:A1000")
Set WS = Worksheets("Scratch Paper")
WS.Activate

Worksheets("Scratch Paper").Range("A2").Resize(Range_Alpha.Rows.Count, Range_Alpha.Columns.Count).Cells.Value = Range_Alpha.Cells.Value
Range_Bravo.SpecialCells(xlCellTypeBlanks).Rows.Delete Shift:=xlShiftUp

WS.Range("A2:A1000").Select
    Selection.AutoFilter
        ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:=Array("1", _
        "210", "220", "221", "224", "226", "228", "781", "781A", "781B", "781C", "781D", "782", "910", "912", "914", "920", "922", _
        "924", "926", "928", "930", "999", "X910", "X920", "X922", "X924", "X926", "X928", "X930", _
        "X930.01", "Y210", "Y220", "Y224", "Y226"), Operator:=xlFilterValues

WS.Range("A2:A1000").SpecialCells(xlCellTypeVisible).ClearContents

WS.ShowAllData


'//////Insert Rows//////

LastRow = WS.Cells.Find( _
                        What:="*", _
                        LookIn:=xlFormulas, _
                        LookAt:=xlPart, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious).Row
For i = LastRow To (FirstRow   RowCount) Step -1
    If (i - FirstRow) Mod RowCount = 0 Then WS.Rows(i & ":" & i   RowsToInsert - 1).Insert Shift:=xlDown
Next i

'/////Copy Data to Asset Information Tab/////

Worksheets("Asset Information").Range("A8").Resize(Range_Bravo.Rows.Count, Range_Bravo.Columns.Count).Cells.Value = Range_Bravo.Cells.Value

'//////Inserts formulas and initial cell formating///////

Worksheets("Asset Information").Activate

Set Range_Charlie = Application.Worksheets("Asset Information").Range("A8:A1000")

For Each Cell_Charlie In Range_Charlie
    If IsEmpty(Cell_Charlie) = False Then
        Cell_Charlie.Offset(0, 8).FormulaR1C1 = "=INDEX(Estimate!C[-8]:C[4],MATCH(RC[-8],Estimate!C[-8],0),13)"
        Cell_Charlie.Offset(5, 8).FormulaR1C1 = "=SUM(R[-5]C:R[-1]C)"
        Cell_Charlie.Offset(5, 8).Font.Bold = True
        Cell_Charlie.Offset(5, 9).FormulaR1C1 = "=SUM(R[-5]C:R[-1]C)"
        Cell_Charlie.Offset(5, 9).Font.Bold = True
        Cell_Charlie.Offset(5, 10).FormulaR1C1 = "=IF(RC[-2]-RC[-1]=0,""MATCH"",""ERROR"")"
        Cell_Charlie.Offset(0, 11).FormulaR1C1 = "=RC[-2]/Tables!R3C7"
        Cell_Charlie.Offset(1, 11).FormulaR1C1 = "=RC[-2]/Tables!R3C7"
        Cell_Charlie.Offset(2, 11).FormulaR1C1 = "=RC[-2]/Tables!R3C7"
        Cell_Charlie.Offset(3, 11).FormulaR1C1 = "=RC[-2]/Tables!R3C7"
        Cell_Charlie.Offset(4, 11).FormulaR1C1 = "=RC[-2]/Tables!R3C7"

        '/////Insert Validation/////
        Cell_Charlie.Offset(0, 4).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=Tables!V3:V58"
        Cell_Charlie.Offset(1, 4).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=Tables!V3:V58"
        Cell_Charlie.Offset(2, 4).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=Tables!V3:V58"
        Cell_Charlie.Offset(3, 4).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=Tables!V3:V58"
        Cell_Charlie.Offset(4, 4).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=Tables!V3:V58"
        Cell_Charlie.Offset(0, 3).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=Tables!K3:K12"
        Cell_Charlie.Offset(1, 3).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=Tables!K3:K12"
        Cell_Charlie.Offset(2, 3).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=Tables!K3:K12"
        Cell_Charlie.Offset(3, 3).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=Tables!K3:K12"
        Cell_Charlie.Offset(4, 3).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=Tables!K3:K12"

        '/////Formula to Reference Table/////
        Cell_Charlie.Offset(0, 5).FormulaR1C1 = "=IFERROR(INDEX(Tables!C[11]:C[16],MATCH(RC[-1],Tables!C[16],0),3),"" "")"
        Cell_Charlie.Offset(1, 5).FormulaR1C1 = "=IFERROR(INDEX(Tables!C[11]:C[16],MATCH(RC[-1],Tables!C[16],0),3),"" "")"
        Cell_Charlie.Offset(2, 5).FormulaR1C1 = "=IFERROR(INDEX(Tables!C[11]:C[16],MATCH(RC[-1],Tables!C[16],0),3),"" "")"
        Cell_Charlie.Offset(3, 5).FormulaR1C1 = "=IFERROR(INDEX(Tables!C[11]:C[16],MATCH(RC[-1],Tables!C[16],0),3),"" "")"
        Cell_Charlie.Offset(4, 5).FormulaR1C1 = "=IFERROR(INDEX(Tables!C[11]:C[16],MATCH(RC[-1],Tables!C[16],0),3),"" "")"
        Cell_Charlie.Offset(0, 7).FormulaR1C1 = "=IFERROR(INDEX(Tables!C[9]:C[15],MATCH(RC[-3],Tables!C[14],0),7),"" "")"
        Cell_Charlie.Offset(1, 7).FormulaR1C1 = "=IFERROR(INDEX(Tables!C[9]:C[15],MATCH(RC[-3],Tables!C[14],0),7),"" "")"
        Cell_Charlie.Offset(2, 7).FormulaR1C1 = "=IFERROR(INDEX(Tables!C[9]:C[15],MATCH(RC[-3],Tables!C[14],0),7),"" "")"
        Cell_Charlie.Offset(3, 7).FormulaR1C1 = "=IFERROR(INDEX(Tables!C[9]:C[15],MATCH(RC[-3],Tables!C[14],0),7),"" "")"
        Cell_Charlie.Offset(4, 7).FormulaR1C1 = "=IFERROR(INDEX(Tables!C[9]:C[15],MATCH(RC[-3],Tables!C[14],0),7),"" "")"

            With Cell_Charlie.Offset(5, 9).Borders(xlEdgeBottom)
                .LineStyle = xlDouble
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThick
            End With
            With Cell_Charlie.Offset(5, 9).Borders(xlEdgeTop)

                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin

            End With
            With Cell_Charlie.Offset(5, 8).Borders(xlEdgeBottom)

                .LineStyle = xlDouble
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThick

            End With

            With Cell_Charlie.Offset(5, 8).Borders(xlEdgeTop)

                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin

            End With

            With Range(Cell_Charlie.Offset(5, 15), Cell_Charlie.Offset(5, 0)).Interior
                .ColorIndex = 48
            End With

    End If

Next Cell_Charlie

Set Range_Delta = Application.Worksheets("Asset Information").Range("L8:L1000")

For Each Cell_Delta In Range_Delta
    If IsEmpty(Cell_Delta) = False Then

    Cell_Delta.Offset(0, 1).FormulaR1C1 = "=(RC[-1]*Tables!R4C7) RC[-3]"

    End If

Next Cell_Delta

'//////Conditional formatting to validate if the task and asset ammounts equal///////

Worksheets("Asset Information").Activate

Range("K8:K1000").Select
    Selection.FormatConditions.Add Type:=xlTextString, String:="MATCH", _
        TextOperator:=xlContains
            Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
                With Selection.FormatConditions(1).Font
                   .ThemeColor = xlThemeColorDark1
                   .TintAndShade = 0
                End With
                With Selection.FormatConditions(1).Interior
                   .PatternColorIndex = xlAutomatic
                   .Color = 5296274
                   .TintAndShade = 0
                End With
                    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlTextString, String:="ERROR", _
        TextOperator:=xlContains
            Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
                With Selection.FormatConditions(1).Font
                    .ThemeColor = xlThemeColorDark1
                    .TintAndShade = 0
                End With
                With Selection.FormatConditions(1).Interior
                    .PatternColorIndex = xlAutomatic
                    .Color = 255
                    .TintAndShade = 0
                End With
                    Selection.FormatConditions(1).StopIfTrue = False

'//////Number formatting/////////

ActiveSheet.Range("I:I").NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
ActiveSheet.Range("J:J").NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
ActiveSheet.Range("M:M").NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
ActiveSheet.Range("L:L").NumberFormat = "0.00%"
Worksheets("Scratch Paper").Visible = False
Worksheets("Tables").Visible = False


'//////Re-enable workbook applications/////

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.AskToUpdateLinks = True

'//////Message Box

MsgBox "Insert Asset Description and Asset Cost"

End Sub

Leave a Reply

Your email address will not be published. Required fields are marked *