Importing new rows based on headers

Carlit007

New Member
Joined
Sep 5, 2018
Messages
36
Office Version
  1. 2019
  2. 2016
  3. 2013
Platform
  1. Windows
  2. MacOS
Hi,

I Have a worksheet which I use to keep inventory of numerous equipment
what I am trying to figure out is how can I import new equipment from another workbook which has a report that is ran frequently.
the data is to go into the active worksheet? called "Equipment Data"
Ideally, I’d like a prompt to select the import file since it will be different every time I use the VBA.

the active sheet has has the following for header

SERIAL NUMBERLINMATERIALDECRYPTIONADMIN
SLOC
SECTIONBLDG

The data coming from the imported file will have some of these Headers listed above as well numerous others which I want to be ignored
what I am trying to do is everytime I run this VBA for the option to import new data which changes frequently

the only thing is If the equipment already exist (Based on Serial Number Column listed on A1 ) I don't want the data to be added/replaced

I came across the following code which almost does what In looking for as far as importing the wanted headers

VBA Code:
Sub ImportBYheaders()
Dim myHeaders, e, x, wsImport As Worksheet, wsMain As Worksheet
Dim r As Range, c As Range
Dim RGserial As Range


myHeaders = Array(Array("Storage Location", "SLOC"), _
Array("Serial Number", "SERIAL"), _
Array("LIN Number", "LIN"), _
Array("Material", "NSN"), _
Array("Descr. of Storage Loc.", "SECTION"), _
Array("Description of technical object", "DESC"), _
Array("Admin No.", "ADMIN"))


Set wsImport = Sheets("Import")
Set wsMain = Sheets("Main")
Set RGserial = wsMain.Range("A2:A8")

For Each e In myHeaders
Set r = wsImport.Cells.Find(e(0), , , xlWhole)

If Not r Is Nothing Then
Set c = wsMain.Cells.Find(e(1), , , xlWhole)

If Not c Is Nothing Then
wsImport.Range(r.Offset(1), wsImport.Cells(Rows.Count, r.Column).End(xlUp)).Copy _
wsMain.Cells(Rows.Count, c.Column).End(xlUp)(2)
Else
msg = msg & vbLf & e(1) & " " & wsMain.Name
End If
Else
msg = msg & vbLf & e(0) & " " & wsImport.Name
End If

Next
If Len(msg) Then
MsgBox "Header not found" & msg

End If
Application.ScreenUpdating = False
End Sub

I would like to combine the VBA Above which does a pretty good Job at copying the headers only with the code below which does a good Job at only importing new data only

VBA Code:
Sub ImportNewDataOnly()

Dim LRow As Long, i As Long
Dim varData As Variant
Dim c As Range

With Sheets("Import")
    LRow = .Cells(Rows.Count, 1).End(xlUp).Row
    varData = .Range("A2:U" & LRow)
End With
    
With Sheets("Main")
    For i = LBound(varData) To UBound(varData)
        Set c = .Range("A:A").Find(varData(i, 1), LookIn:=xlValues, LookAt:=xlWhole)
        If c Is Nothing Then
            .Cells(Rows.Count, 1).End(xlUp)(2).Resize(1, UBound(varData, 2)) _
                = Application.Index(varData, i)
        Else
            .Cells(c.Row, 1).Resize(1, UBound(varData, 2)) _
                = Application.Index(varData, i)
        End If
    Next
End With
End Sub

If theres any way to simplify these task I'm also open
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.

Forum statistics

Threads
1,137,125
Messages
5,679,755
Members
419,855
Latest member
Eddier32

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
Top