importing data - check if already exist replace or else insert in the bottom

[Hawjeen]

Hi,

I got a task that are a bit over my current vba skills, and i was hoping that someone could help me out.

i need to import some data regulary and update a database.

what my need is, to check if the data in column A in sheet2 (new data) already is in column A in data (database).

if yes it should check if the value in column sheet2.R=data.R, if that is not the case, i would like it to replace the values from A:R. If it is the same it can just go to next value in sheet2.column A.

if the value in sheet2.column A dosent exist, i want to copy values from A:R and insert in the bottom of my table in sheet.data.

i hope this is understandeable, and that someone can save me from a lot of manual work in the future.

 

[Fluff]

How about

Sub UpdateData()

   Dim Cl As Range
   Dim Itm As Variant
   Dim Dws As Worksheet
   Dim Sws As Worksheet
   
   Set Dws = Sheets("Data")
   Set Sws = Sheets("New Data")
   With CreateObject("scripting.dictionary")
      For Each Cl In Sws.Range("A2", Sws.Range("A" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then .Add Cl.Value, Array(Cl.Offset(, 17).Value, Cl.Resize(, 18))
      Next Cl
      For Each Cl In Dws.Range("A2", Dws.Range("A" & Rows.Count).End(xlUp))
         If .exists(Cl.Value) Then
            If Not Cl.Offset(, 17).Value = .Item(Cl.Value)(0) Then
               Cl.Resize(, 18).Value = .Item(Cl.Value)(1).Value
            End If
            .Remove Cl.Value
         End If
      Next Cl
      If Not .Count > 0 Then Exit Sub
      For Each Itm In .items
         Dws.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 18).Value = Itm(1).Value
      Next Itm
   End With
            
End Sub

 

[Hawjeen]

it gives an runtime error 32811
it happens on the line .remove CI.value

 

[Fluff]

Not sure why you are getting that.
Did you copy & paste the code, or type it out?

 

[Hawjeen]

i copied.
but i simply just deleted the line which triggered the error, and now it seems to run.

but i can see a small problem, it looks like it is pasting all lines from the "new data", even though it is in the database and no differnce in column R

 

[Fluff]

Without that line of code, the entire New Data sheet will be copied over.
Lets try it the other way round

Sub UpdateData()

   Dim Cl As Range
   Dim Dws As Worksheet
   Dim Sws As Worksheet
   
   Set Dws = Sheets("Data")
   Set Sws = Sheets("New Data")
   With CreateObject("scripting.dictionary")
      For Each Cl In Dws.Range("A2", Dws.Range("A" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then .Add Cl.Value, Array(Cl.Offset(, 17).Value, Cl.Resize(, 18))
      Next Cl
      For Each Cl In Sws.Range("A2", Sws.Range("A" & Rows.Count).End(xlUp))
         If .exists(Cl.Value) Then
            If Not Cl.Offset(, 17).Value = .Item(Cl.Value)(0) Then
               .Item(Cl.Value)(1).Value = Cl.Resize(, 18).Value
            End If
         Else
            Dws.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 18).Value = Cl.Resize(, 18).Value
         End If
      Next Cl
   End With
End Sub

 

[Hawjeen]

WOW!

It looks like it is working exactly the way i need!!
thank you so much

regards
Hawjeen

 

[Fluff]

Glad to help & thanks for the feedback

 

[aditynigam]

I have recently started using vba and wanted to know that where and how can i specify the 2 sheets I want to use for this program ?

 

[Fluff]

You do that with the two lines in red

Sub UpdateData()

   Dim Cl As Range
   Dim Dws As Worksheet
   Dim Sws As Worksheet
   
   Set Dws = Sheets("Data")
   Set Sws = Sheets("New Data")
   With CreateObject("scripting.dictionary")
      For Each Cl In Dws.Range("A2", Dws.Range("A" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then .Add Cl.Value, Array(Cl.Offset(, 17).Value, Cl.Resize(, 18))
      Next Cl
      For Each Cl In Sws.Range("A2", Sws.Range("A" & Rows.Count).End(xlUp))
         If .exists(Cl.Value) Then
            If Not Cl.Offset(, 17).Value = .Item(Cl.Value)(0) Then
               .Item(Cl.Value)(1).Value = Cl.Resize(, 18).Value
            End If
         Else
            Dws.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 18).Value = Cl.Resize(, 18).Value
         End If
      Next Cl
   End With
End Sub