CODEWITHSUNDEEP
excelvba
Raudert
Raudert

Reputation: 5

Searching Between 2 Sheets for Matches and Adding New Row If No Match Found

For this scenario I have a "Database" Spreadsheet with a SubSheet that feeds off the "Database". Currently I have a VBA script written to check the Database sheet for matches of a certain cell in each row of the sheet. If a match is found that row from the SubSheet is copied over that row on the Database sheet.

What I want added is another condition that if no Match is found for the row on the SubSheet currently targeted then that row is added to the bottom of the Database sheet.

I have tried adding:

ws2.Rows(ws2Row).EntireRow.Value = ws1.Rows(ws1LastRow + 1).EntireRow.Value

after my search loop but that doesn't quite work and I am not sure why. 

Sub Update_Master()

Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim ws1LastRow As Long, ws2LastRow As Long
Dim ws1Row As Long, ws2Row As Long

Application.ScreenUpdating = False

Set wb1 = ThisWorkbook
Set ws1 = wb1.Worksheets("Sheet1")

Set wb2 = Application.Workbooks.Add("C:\Users\MyFolder\Desktop\Excel Master Test\ROLE BASED TRACKER DRAFT.xlsx")
Set ws2 = wb2.Worksheets("Database")

ws1LastRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
ws2LastRow = ws2.Cells(Rows.Count, "A").End(xlUp).Row

For ws1Row = 2 To ws1LastRow
    ws1.AutoFilterMode = False
    If ws1.Cells(ws1Row, 4).Value > 0 Then

        For ws2Row = 2 To ws2LastRow
            ws2.AutoFilterMode = False
            If ws2.Cells(ws2Row, 4).Value = ws1.Cells(ws1Row, 4).Value Then
                ws2.Rows(ws2Row).EntireRow.Value = ws1.Rows(ws1Row).EntireRow.Value
            End If

        Next ws2Row

    End If

Next ws1Row

ws2.Rows(ws2Row).EntireRow.Value = ws1.Rows(ws1LastRow + 1).EntireRow.Value

End Sub

Upvotes: 0

Views: 103

Answers (2)

Raudert
Raudert

Reputation: 5

For anyone that stumbles across this I found the answer to my question. I used the find method to search the sheet for a match. Under an If statement I used the "Is Nothing" condition to copy the current row to the end of the sheet. See the solution below. 

If ws2.Range("D:D").Find(What:=ws1.Cells(ws1Row, 4).Text, _
        LookIn:=xlValues) Is Nothing Then
    ws1.Cells(ws1Row).EntireRow.Value = ws2.Cells(ws2LastRow + 1).Value

Upvotes: 0

Raudert
Raudert

Reputation: 5

So I have this loop to update the Database with the information from the SubSheet using the Find method. From here how can I make it copy the information when a match is not found? I'm sorry.. i'm new to programming as a whole and just picked up VBA a couple days ago. 

For ws1Row = 2 To ws1LastRow

    Do While ws1.Cells(ws1Row, 4) <> "" 'repeat the following loop until it reaches a blank row

        strSearch = ws1.Cells(ws1Row, 4).Value   'get a hold of the value in column D

        ws1.Rows(ws1Row).EntireRow.Copy 'copy the row to be transferred to the Database

        ws2.Activate

        ws2.Range("D:D").Find(strSearch).Select  'find the row the match is located at on the Database

        r = ActiveCell.Row   'get a hold of current row index

        Range(r & ":" & r).Select

        ActiveCell.PasteSpecial xlPasteAll  'Past the entire row to the Database

        ActiveCell.Offset(1, 0).Select  'go down one row to prepare for next row

        ws1Row = ws1Row + 1

    Loop   'repeat

Next

Upvotes: 0

Related Questions