VBA to update one sheet from data stored in another workbook

L

Lorum

New Member
Joined
Aug 11, 2020
Messages
1
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
  2. Mobile
  3. Web
Hello there!

How are you? I hope you can help me. I'm new in VBA and I have an issue I can't resolve. I'll try to explain what I need.

I have Workbook A and Workbook B.

Data in Workbook A is updated by clicking a button. It takes information from another Workbook B that is generated by an external program in extension .xlsx.

  1. DAY 1. I exported my Workbook B by using my external program.

DATEIDTYPETIME
11/08/202080205029BAT10:50
11/08/202080206789DAT10:51
16/08/202080205029BAT17:12
20/08/202080976534BAT23:42
21/08/202080212456TAT07:25

2. DAY 1. Then I run my macro and I get that data into my Workbook A. The Description column is treated later and is not included in Workbook B.

DATEIDDESCRIPTIONTYPETIME
11/08/202080205029BAT10:50
11/08/202080206789DAT10:51
16/08/202080205029BAT17:12
20/08/202080976534BAT23:42
21/08/202080212456TAT07:25

2. DAY 3. I entered and complete columns in Workbook A.

DATEIDDESCRIPTIONTYPETIME
11/08/202080205029Everything OKBAT10:50
11/08/202080206789RequestedDAT10:51
16/08/202080205029Everything OKBAT17:12
20/08/202080976534Nothing to doBAT23:42
21/08/202080212456RequestedTAT07:25

3. DAY 7. The program has generated a new Workbook B with new data. Some new rows could have been added in Workbook B, and even some cells in the TYPE column has been changed for one item already inserted in Workbook A.

DATEIDTYPETIME
11/08/202080205029BAT10:50
11/08/202080206789BAT14:07
11/08/202080206789DAT10:51
18/08/202080003567DAT13:18
20/08/202080976534TAT23:42
21/08/202080212456TAT07:25
22/08/202080009345BAT05:52
24/08/202080195642DAT11:24

Notice what happened:

  • A new line appeared in ROW 2 with same day, same ID but it is a different TIME, not necessarily sorted.
  • The ROW containing DATE 16/08/2020 and ID 80205029 has disappeared.
  • A new line appeared in ROW 4 with new data.
  • The TYPE cell has changed its value for ROW 5.
  • New lines appear at the end.
What I want is Worksheet A to be updated like this:


DATEIDDESCRIPTIONTYPETIME
11/08/202080205029Everything OKBAT10:50
11/08/202080206789BAT14:07
11/08/202080206789RequestedDAT10:51
18/08/202080003567DAT13:18
20/08/202080976534Nothing to doTAT23:42
21/08/202080212456RequestedTAT07:25
22/08/202080009345BAT05:52
24/08/202080195642DAT11:24

So I want the update to add new rows in the right order, not to delete the rows that have been previously inserted and have disappeared in the new Worksheet B exported, and to change the values of those cells that have changed in the TYPE column.

I have tried plenty of things, the last was a double FOR but it is bad coding.

VBA Code: 
Sub Update()

Dim lastRowScr As Integer, lastRowLocal As Integer, nRowsSrc As Integer, nRowsLocal As Integer, x As Integer, _
y As Integer

    Application.ScreenUpdating = False
    
       Set closedBook = Workbooks.Open("C:\Users\mfortesg\Documents\Suivi d'Analyses AT\Projet - Automatisation\BO\BO.xlsx")
      
       lastRowScr = closedBook.Sheets(1).Cells.Find(What:="*", SearchDirection:=xlPrevious).Row - 2
       nRowsScr = lastRowScr - 16
      
       lastRowLocal = ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells.Find(What:="*", SearchDirection:=xlPrevious).Row
       nRowsLocal = lastRowLocal - 2
      
       If nRowsLocal = 0 Then
      
            For x = 17 To lastRowScr
            
                y = x - 14
                        
                ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(y, 1).Value = closedBook.Sheets(1).Cells(x, 1).Value
                ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(y, 2).Value = closedBook.Sheets(1).Cells(x, 2).Value
                ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(y, 3).Value = closedBook.Sheets(1).Cells(x, 3).Value
                ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(y, 4).Value = closedBook.Sheets(1).Cells(x, 4).Value
                ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(y, 5).Value = closedBook.Sheets(1).Cells(x, 17).Value
                ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(y, 6).Value = closedBook.Sheets(1).Cells(x, 11).Value
                ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(y, 7).Value = closedBook.Sheets(1).Cells(x, 10).Value
                ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(y, 8).Value = closedBook.Sheets(1).Cells(x, 26).Value
                ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(y, 24).Value = Replace(closedBook.Sheets(1).Cells(x, 28).Value, ",", ":")
            
            Next x
            
            MsgBox ("Le Tableau d'Analyse AT a été mis à jour correctement.")
        
            Else
            
            For x = 17 To lastRowScr
    
                For y = x - 14 To lastRowLocal + 1
                    
                    If ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(y, 1).Value = closedBook.Sheets(1).Cells(x, 1).Value And _
                       ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(y, 2).Value = closedBook.Sheets(1).Cells(x, 2).Value And _
                       ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(y, 24).Value = Replace(closedBook.Sheets(1).Cells(x, 28).Value, ",", ":") Then
                    
                        ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(y, 6).Value = closedBook.Sheets(1).Cells(x, 11).Value
                        ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(y, 5).Value = closedBook.Sheets(1).Cells(x, 17).Value
                        
                    ElseIf y = lastRowLocal + 1 Then
                                    
                        ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(x - 14, 1).Value = closedBook.Sheets(1).Cells(x, 1).Value
                        ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(x - 14, 2).Value = closedBook.Sheets(1).Cells(x, 2).Value
                        ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(x - 14, 3).Value = closedBook.Sheets(1).Cells(x, 3).Value
                        ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(x - 14, 4).Value = closedBook.Sheets(1).Cells(x, 4).Value
                        ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(x - 14, 5).Value = closedBook.Sheets(1).Cells(x, 17).Value
                        ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(x - 14, 6).Value = closedBook.Sheets(1).Cells(x, 11).Value
                        ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(x - 14, 7).Value = closedBook.Sheets(1).Cells(x, 10).Value
                        ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(x - 14, 8).Value = closedBook.Sheets(1).Cells(x, 26).Value
                        ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(x - 14, 24).Value = Replace(closedBook.Sheets(1).Cells(x, 28).Value, ",", ":")
                    
                    End If
                    
                Next y
            
            Next x
            
            MsgBox ("Le Tableau d'Analyse AT a été mis à jour correctement.")
        
        End If
            
       closedBook.Close SaveChanges:=False

    
    Application.ScreenUpdating = True

End Sub

Can anyone help me? Please!

Thanks in advance.
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
You must log in or register to reply here.

Similar threads

H
  • Solved
Search for topics based on their groups.
Replies
7
Views
133
Peter_SSs
Peter_SSs
K
  • Question
conditional formatting question
Replies
2
Views
153
kerm007
K
G
  • Question
Excel VBA Open Word Doc and Save as New Word Doc
Replies
1
Views
87
NdNoviceHlp
NdNoviceHlp
K
  • Question
VBA : Copy only new information from specific cells in another worksheet
Replies
6
Views
612
kevin9999
K
K
  • Solved
Update to existing Move data macro
2
Replies
11
Views
262
Alex Blakenburg
A

Forum statistics

Threads
1,214,650
Messages
6,120,734
Members
448,987
Latest member
marion_davis

Share this page

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