Insert Rows VBA - vba

Question

Right now I have a master excel workbook that employees use for data entry. Each of them downloads a copy to their desktops and then marks their progress on various entries by entering an "x" in a comlun next to the data they've finished. Each product has its own row with its respective data listed across that row. The master workbook is filled out throughout the quarter with new data for the products as it becomes available, which is currently updated on each individuals workbook by use of a macro that simply copies the range where the data is (see code below).
Sub GetDataFromClosedWorkbook()
'Created by XXXX 5/2/2014
Application.ScreenUpdating = False ' turn off the screen updating
Dim wb As Workbook
Set wb = Workbooks.Open("LOCATION OF FILE", True, True)
' open the source workbook, read only
With ThisWorkbook.Worksheets("1")
' read data from the source workbook: (Left of (=) is paste # destination, right of it is copy)
.Range("F8:K25").Value = wb.Worksheets("1").Range("F8:K25").Value
End With
With ThisWorkbook.Worksheets("2")
' read data from the source workbook: (Left of (=) is paste # destination, right of it is copy)
.Range("V5:Z359").Value = wb.Worksheets("2").Range("V5:Z359").Value
End With
wb.Close False ' close the source workbook without saving any changes
Set wb = Nothing ' free memory
Application.ScreenUpdating = True ' turn on the screen updating
End Sub
The problem I'm having is this: every once and a while, I'll need to add a new product, which adds a row on the master (this is opposed to adding data, which is just added across the row). Sometimes this row is at the end, sometimes it's in the middle. As you can see from the code below, my VBA currently can't handle this row change as it is just copy/pasting from a predefined range. Each users's workbook does not pick up on this change in row # and thus the data in the colums becomes associated with the wrong rows. Normally, you could just copy the entire sheet and problem solved. The issue I have is that each user needs to be able to record their own process in their own workbook next to their data. Is there a way to code this so that a new row on the master sheet will be accounted for and added to all the others without erasing/moving the marks made by each user? I've been trying to find a way to make it "insert" rows if they're new in the master, as this would preserve the data, but can't figure it out. Also, due to security on the server at work- linking workbooks, etc is not an option. Does anyone have any thoughts on this?

Answer 1

One way to approach this problem would be using the Scripting.Dictionary Object. You could create a dictionary for both the target and source identifiers and compare those. I suppose you don't really need the Key-Value pair to achieve this, but hopefully this gets you on the right track!
Sub Main()
Dim source As Worksheet
Dim target As Worksheet
Dim dictSource As Object
Dim dictTarget As Object
Dim rng As Range
Dim i As Integer
Dim j As Integer
Dim idSource As String
Dim idTarget As String
Dim offset As Integer
Set source = ThisWorkbook.Sheets(2)
Set target = ThisWorkbook.Sheets(1)
offset = 9 'My data starts at row 10, so the offset will be 9
Set rng = source.Range("A10:A" & source.Cells(source.Rows.Count, "A").End(xlUp).Row)
Set dictSource = CreateObject("Scripting.Dictionary")
For Each cell In rng
dictSource.Add Key:=cell.Value, Item:=cell.Row
Next
Set rng = target.Range("A10:A" & target.Cells(target.Rows.Count, "A").End(xlUp).Row)
Set dictTarget = CreateObject("Scripting.Dictionary")
For Each cell In rng
dictTarget.Add Key:=cell.Value, Item:=cell.Row
Next
i = 1
j = source.Range("A10:A" & source.Cells(source.Rows.Count, "A").End(xlUp).Row).Rows.Count
Do While i <= j
Retry:
idSource = source.Cells(i + offset, 1).Value
idTarget = target.Cells(i + offset, 1).Value
If Not (dictSource.Exists(idTarget)) And idTarget <> "" Then
'Delete unwanted rows
target.Cells(i + offset, 1).EntireRow.Delete
GoTo Retry
End If
If dictTarget.Exists(idSource) Then
'The identifier was found so we can update the values here...
dictTarget.Remove (idSource)
ElseIf idSource <> "" Then
'The identifier wasn't found so we can insert a row
target.Cells(i + offset, 1).EntireRow.Insert
'And you're ready to copy the values over
target.Cells(i + offset, 1).Value = idSource
End If
i = i + 1
Loop
Set dictSource = Nothing
Set dictTarget = Nothing
End Sub