Update cells at other sheet

[broogle]

I really need an excel guru to help to solve my problem.

The situation is like this:

Sheet1.ColumnB Sheet2.ColumnB Sheet2.ColumnC

Canada Canada 23
Germany Germany 45
Russia Russia 32
Japan Japan 22

User are free to change or delete/insert row(s) at Sheet1.ColumnB, and
Sheet2.ColumnB must follow whatever value in Sheet1.ColumnB, the
problem
I have is I don't know how to make the value in Sheet2.ColumnC to keep
following the Sheet2.ColumnB.
For example, if I insert USA between Canada and Germany, I want the
result in Sheet2 as :

Sheet1.ColumnB Sheet2.ColumnB Sheet2.ColumnC

Canada Canada 23
USA USA
Germany Germany 45
Russia Russia 32
Japan Japan 22


And Sheet2.ColumnC for USA will be left as blank and user can enter the
value later.

Appreciate your help.

 

[Guest]

Hi Broogle,

Use the following formula in Cell B1 of Sheet 2

=IF(INDIRECT("Sheet1!" & ADDRESS(ROW(),2))="","",INDIRECT("Sheet1!" &
ADDRESS(ROW(),2)))

and the following formula for Cell C1 of Sheet 2

=IF(ISNA(LOOKUP(B1,{"a","b","c","d","e","f","g"},{1,2,3,4,5,6,7})),"",LOOKUP(B1,{"a","b","c","d","e","f","g"},{1,2,3,4,5,6,7}))

Just replace the "a","b" etc with country names and 1,2,3, etc with values.
Drag down as many rows as you like

Alok Joshi

 

[broogle]

Hi Alok,
It should be done in macro, because the data could be more than 100, I
can't fit them in formula.
Thank you anyway.

 

[Guest]

Broogle,

Here is the code .. you might have to revise some
Add all the following into Module1

Global gCol As New Collection

Sub UpdateCollection()

Dim r&
With Sheet2
For r = 1 To .UsedRange.Rows.Count
If .Cells(r, 2).Value <> "" Then
On Error Resume Next
gCol.Add .Cells(r, 3).Value, .Cells(r, 2).Value
On Error GoTo 0
End If
Next r
End With
End Sub
Sub UpdateSheet()

Dim r&
With Sheet2
For r = 1 To .UsedRange.Rows.Count
If .Cells(r, 2).Value <> "" Then
On Error Resume Next
.Cells(r, 3).Value = gCol(.Cells(r, 2).Value)
On Error GoTo 0
End If
Next r
End With

End Sub
Sub SynchronizeSheets()

Dim r&
With Sheet2
'Clear the two columns
With .Range(.Cells(1, 2), .Cells(.UsedRange.Rows.Count, 3))
.ClearContents
End With
For r = 1 To Sheet1.UsedRange.Rows.Count
.Cells(r, 2).Value = Sheet1.Cells(r, 2).Value
Next r
End With

End Sub

Add this bit in the Sheet1_Change event

Private Sub Worksheet_Change(ByVal Target As Range)
SynchronizeSheets
UpdateSheet
End Sub

And add the following in the Workbook_Open event
Private Sub Workbook_Open()
UpdateCollection
End Sub

Hope this works for you.

Alok Joshi

 

[broogle]

Hi Alok,

When I tried to insert USA between Canada and Germany, it only works
for Sheet2.ColumnB and the position of Sheet2.ColumnC remain the same,
all numbers didn't align with the changes. Could you please help me to
modife the macro.
Thanks a million.

 

[Guest]

Hi Broogle,

I do not have the workbook I set up to test the code. I will do that
tomorrow and send you an update.

Alok Joshi

 

[broogle]

Thanks Alok!
I really appreaciate your time.

I can email you my worksheet if you want to.

Cheers
broogle

 

[Guest]

Broogle,

Here is the revised code
These go into the Sheet2' events
Private Sub Worksheet_Activate()
SynchronizeSheets
UpdateSheet
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Sheet2.Columns("B:B")) Is Nothing Or _
Not Intersect(Target, Sheet2.Columns("C:C")) Is Nothing Then
UpdateCollection
End If
End Sub

These go into the module
Global gCol As New Collection

Sub UpdateCollection()
Dim r&, bError As Boolean
With Sheet2
For r = 1 To .UsedRange.Rows.Count
If .Cells(r, 2).Value <> "" Then

bError = False
On Error Resume Next
gCol.Add Item:=.Cells(r, 3).Value, Key:=.Cells(r, 2).Value
bError = (Err <> 0)
On Error GoTo 0

If bError Then
'existing item. Change the value associated with it.
gCol.Remove (.Cells(r, 2).Value)
gCol.Add Item:=.Cells(r, 3).Value, Key:=.Cells(r, 2).Value
End If
End If
Next r
End With
End Sub
Sub UpdateSheet()

Dim r&
Application.EnableEvents = False
With Sheet2
For r = 1 To .UsedRange.Rows.Count
If .Cells(r, 2).Value <> "" Then
On Error Resume Next
.Cells(r, 3).Value = gCol(.Cells(r, 2).Value)
On Error GoTo 0
End If
Next r
End With
Application.EnableEvents = True

End Sub
Sub SynchronizeSheets()

Dim r&
Application.EnableEvents = False
With Sheet2
'Clear the two columns
With .Range(.Cells(1, 2), .Cells(.UsedRange.Rows.Count, 3))
.ClearContents
End With
For r = 1 To Sheet1.UsedRange.Rows.Count
.Cells(r, 2).Value = Sheet1.Cells(r, 2).Value
Next r
End With
Application.EnableEvents = True

End Sub

And this goes into the Workbook_Open
Private Sub Workbook_Open()
UpdateCollection
End Sub

Hope this works completely.

Alok Joshi