CODEWITHSUNDEEP
vbaloopsrange
Mitchell Lawlor
Mitchell Lawlor

Reputation: 45

VBA getting more than one value for a range

I am creating a code that will look through a full column to make sure there is no cell that already has the same value in column D. My problem is I can't figure out a way to change the range to search through more then 1 cell in this case D5. I tried making a loop but where I am newer to coding I don't know a specific way. Anything that helps is much appreciated.

Sub SaveData()
Dim the_sheet As Worksheet
Dim table_list_object As ListObject
Dim table_object_row As ListRow
Dim Name As String


Set the_sheet = Sheets("Saved Data")

Name = the_sheet.Range("D5")

If Name = Worksheets("Drilling Calculations").Cells(2, 3) Then

MsgBox "Error - Well Name Already Exists. Well Not Saved"

Else

Set table_list_object = the_sheet.ListObjects(1)
Set table_object_row = table_list_object.ListRows.Add

    table_object_row.Range(1, 1).Value = Worksheets("Drilling Calculations").Cells(2, 3)
    table_object_row.Range(1, 2).Value = Worksheets("Drilling Calculations").Cells(5, 5)
    table_object_row.Range(1, 3).Value = Worksheets("Drilling Calculations").Cells(6, 5)
    table_object_row.Range(1, 4).Value = Worksheets("Drilling Calculations").Cells(7, 5)
    table_object_row.Range(1, 5).Value = Worksheets("Drilling Calculations").Cells(8, 5)
    table_object_row.Range(1, 6).Value = Worksheets("Drilling Calculations").Cells(5, 17)
    table_object_row.Range(1, 7).Value = Worksheets("Drilling Calculations").Cells(6, 17)
    table_object_row.Range(1, 8).Value = Worksheets("Drilling Calculations").Cells(7, 17)
    table_object_row.Range(1, 9).Value = Worksheets("Drilling Calculations").Cells(8, 17)
    table_object_row.Range(1, 10).Value = Worksheets("Drilling Calculations").Cells(10, 23)

MsgBox "Data Saved"

End If

End Sub

Upvotes: 1

Views: 172

Answers (1)

FAB
FAB

Reputation: 2569

Give this a try, let me know if need further help...

Sub SaveData()
Dim the_sheet As Worksheet
Dim table_list_object As ListObject
Dim table_object_row As ListRow
Dim Name As String

    Set the_sheet = Sheets("Saved Data")

    'Get the last row
    Dim lastRow As Long
    lastRow = the_sheet.Cells(sht.Rows.Count, "D").End(xlUp).Row

    Dim bolCheck As Boolean
    Dim R As Long                   'row
    For R = 1 To lastRow            'Iterate through all rows
        If the_sheet.Cells(R, 4) = Worksheets("Drilling Calculations").Cells(2, 3) Then     'If a match found then set to false
            bolCheck = True
            Exit For                'Match found, exit here...
        End If
    Next R

'Now we know if there is a duplicate or not
    If bolCheck Then

        MsgBox "Error - Well Name Already Exists. Well Not Saved"

    Else

        Set table_list_object = the_sheet.ListObjects(1)
        Set table_object_row = table_list_object.ListRows.Add

        table_object_row.Range(1, 1).Value = Worksheets("Drilling Calculations").Cells(2, 3)
        table_object_row.Range(1, 2).Value = Worksheets("Drilling Calculations").Cells(5, 5)
        table_object_row.Range(1, 3).Value = Worksheets("Drilling Calculations").Cells(6, 5)
        table_object_row.Range(1, 4).Value = Worksheets("Drilling Calculations").Cells(7, 5)
        table_object_row.Range(1, 5).Value = Worksheets("Drilling Calculations").Cells(8, 5)
        table_object_row.Range(1, 6).Value = Worksheets("Drilling Calculations").Cells(5, 17)
        table_object_row.Range(1, 7).Value = Worksheets("Drilling Calculations").Cells(6, 17)
        table_object_row.Range(1, 8).Value = Worksheets("Drilling Calculations").Cells(7, 17)
        table_object_row.Range(1, 9).Value = Worksheets("Drilling Calculations").Cells(8, 17)
        table_object_row.Range(1, 10).Value = Worksheets("Drilling Calculations").Cells(10, 23)

        MsgBox "Data Saved"

    End If

End Sub

Upvotes: 2

Related Questions