CODEWITHSUNDEEP
vbaexcel
nabilah
nabilah

Reputation: 211

Inserting the new found rows below the column header

Hi currently i have a code that helps me to copy and paste information on a new found row from external workbook based on a matching condition such as "Singapore". The code will look through the sheet in the external workbook and search for all rows that have "Singapore" in the column and paste it to another workbook. But the problem i am facing right now is that the rows that is being copied and paste to is overlapping my column header instead of inserting on the last row of the sheet. Below is the image that the information from the external workbook will be pasted to. enter image description here

However when i run the code as below:

Sub UpdateNewUpcomingProj()

    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim copyFrom As Range
    Dim lRow As Long '<~~ Not Integer. Might give you error in higher versions of excel
    Dim strSearch As String

    Set wb1 = Application.Workbooks.Open("U:\Active Master Project.xlsm")
    Set ws1 = wb1.Worksheets("New Upcoming Projects")

    strSearch = "Singapore"

    With ws1

        '~~> Remove any filters
        .AutoFilterMode = False

        '~~> I am assuming that the names are in Col A
        '~~> if not then change A below to whatever column letter
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        With .Range("A1:A" & lRow)

            .AutoFilter Field:=1, Criteria1:="=*" & strSearch & "*"

            Set copyFrom = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow

        End With

        .AutoFilterMode = False

    End With

    '~~> Destination File
    Set wb2 = ThisWorkbook
    Set ws2 = wb2.Worksheets("New Upcoming Projects")

     With ws2

        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then

            lRow = .Cells.Find(What:="*", _
                          After:=.Range("A2"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
        Else
            lRow = 2

        End If

     copyFrom.Copy
    .Rows(lRow).PasteSpecial xlPasteAllExceptBorders, xlPasteSpecialOperationNone, False, False
    .Rows.RemoveDuplicates Array(2), xlNo

    End With

End Sub

It give this result: enter image description here It seems that the information is overlapping the column header instead of pasting it below the column header itself. I hope anyone could assist me in the codes to solve the problem of the rows being pasted on the column headers instead of on the empty rows. Any help would be appreciated. Thank you.

Upvotes: 0

Views: 33

Answers (1)

Stanley
Stanley

Reputation: 2806

You might have to add the line

lRow = lRow + 1

after the section

    lRow = .Cells.Find(What:="*", _
                  After:=.Range("A2"), _
                  Lookat:=xlPart, _
                  LookIn:=xlFormulas, _
                  SearchOrder:=xlByRows, _
                  SearchDirection:=xlPrevious, _
                  MatchCase:=False).Row

Upvotes: 1

Related Questions