Find value in worksheet, copy to new row of table in second worksheet

austin09

New Member
Joined
Sep 21, 2019
Messages
1
Hi all,

I'm new to the forum and VBA, so thanks in advance for the help!

This is what I'm trying to do
1) import data from a text file into a data pane that will feed into a dashboard,
2) search for keywords in the data to find cell references, and
3) copy this data into a new row of an existing table (with each column a named range) in a second worksheet.

This is the code I've got so far:
Code:
Sub Import()
' This Macro is intended to import data from the cover sheet of a new well into the data table of the GeoOps Dashboard
' -------------------------------------------
' Retrieve CoverSheetENG workbook and copy to new sheet "tempCoversheet"...
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets.Add(After:= _
             ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    ws.Name = "tempCoversheet"
    Dim wkbCrntWorkBook As Workbook
    Dim wkbSourceBook As Workbook
    Dim rngSourceRange As Range
    Dim rngDestination As Range
    Set wkbCrntWorkBook = ActiveWorkbook
        MsgBox "If asked to update links, choose `Don't Update`"
        
    With Application.FileDialog(msoFileDialogOpen)
        .Filters.Clear
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then
            Workbooks.Open .SelectedItems(1)
            Set wkbSourceBook = ActiveWorkbook
            Worksheets("Cover-Sheet ENG").Activate
            Set rngSourceRange = Range("A1:V74")
            wkbCrntWorkBook.Activate
            Set rngDestination = Range("A1:V74")
            rngSourceRange.Copy rngDestination
            rngDestination.CurrentRegion.EntireColumn.AutoFit
            wkbSourceBook.Close False
        End If
    End With
' New line in "Well_Data" Table
Sheets("tempCoversheet").Cells.UnMerge
Dim tbl As ListObject
Set tbl = Sheets("Data Pane").ListObjects("Well_Data")
tbl.ListRows.Add


' Copy data from "tempCoversheet" to "Data Pane"
    Dim Data0 As Variant
    Dim Data1 As Variant
'    Dim Data2 As Variant
'    Dim Data3 As Variant
'    Dim Data4 As Variant
'    Dim Data5 As Variant
'    Dim Data6 As Variant
'    Dim Data7 As Variant
'    Dim Data8 As Variant
'    Dim Data9 As Variant
'    Dim Data10 As Variant
'    Dim Data11 As Variant
'    Dim Data12 As Variant
'    Dim Data13 As Variant
'    Dim Data14 As Variant
'    Dim Data15 As Variant
'    Dim Data16 As Variant
'    Dim Data17 As Variant
'    Dim Data18 As Variant
        
    Data0 = Array("Well Name")
    Data1 = Array("Drilling Rig")
'    Data2 = Array("Well profile")
'    Data3 = Array("Type of Completion")
'    Data4 = Array("End of tangent")
'    Data5 = Array("Planned Spud date")
'    Data6 = Array("Casing Point")
'    Data7 = Array("Target T2")
'    Data8 = Array("TD (target T3)")
'    Data9 = Array("Outstep at TD, m")
'    Data10 = Array("Coring / Special logging")
'    Data11 = Array("") 'Logging and Sampling
'    Data12 = Array("") 'Logging and Sampling
'    Data13 = Array("") 'Logging and Sampling
'    Data14 = Array("") 'Logging and Sampling
'    Data15 = Array("") 'Logging and Sampling
'    Data16 = Array("") 'Logging and Sampling
'    Data17 = Array("") 'Logging and Sampling
'    Data18 = Array("") 'Logging and Sampling
    
    Dim Rng0 As Range
    Dim Rng1 As Range
    Dim I As Long
    Dim temp As Worksheet
    Dim DataPane As Worksheet
    
    Set temp = Sheets("tempCoversheet")
    Set DataPane = Sheets("Data Pane")
    With temp.Range("A1:V74")
        Set Rng0 = .Find(What:=Data0(I), _
                    After:=.Cells(.Cells.Count), _
                    LookIn:=xlFormulas, _
                    LookAt:=xlWhole, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
        DataPane.Range("Well_Data[Well Name]").End(xlDown).Offset(0, 0).Value = Rng0.Offset(0, 2)
    End With
    With temp.Range("A1:V74")
        Set Rng1 = .Find(What:=Data1(I), _
                    After:=.Cells(.Cells.Count), _
                    LookIn:=xlFormulas, _
                    LookAt:=xlWhole, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
         DataPane.Range("Well_Data[Rig]").End(xlDown).Offset(0, 0).Value = Rng1.Offset(0, 1)
    End With
   
'Delete temporary worksheet
Worksheets("tempCoversheet").Delete


Application.ScreenUpdating = True
Application.DisplayAlerts = True
Sheets("Data Pane").Select
    End Sub

I think I've got my relative referencing wrong because the data will import, but not to the bottom row of the table. It varies where it will copy the data to depending on what is above it. Any ideas what I'm doing wrong?

Thanks,
Austin
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)

Forum statistics

Threads
1,213,511
Messages
6,114,054
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top