gravanoc
Active Member
- Joined
- Oct 20, 2015
- Messages
- 351
- Office Version
- 365
- Platform
- Windows
- Mobile
Workbook can be downloaded here.
Scenario: 10 people are using a shared workbook. There are 10 tabs, of which 9 are considered Biller tabs & 1 is the Master tab. The Master tab is just the aggregate of all the Biller tabs, minus the extra header rows. All tabs are using a giant table for all the input data.
The intended task list (not in any order) is:
1) Any of the 9 biller agents enter data on their respective tab, and this is automatically synced to the Master.
2) Likewise, if the Master tab updates something on its tab that is within a specific biller's domain, then that biller tab will sync the new data in the correct cell.
The above steps are not a problem AFAIK, and seem to work fine with my code. The next steps are what have been a problem.
3) Either the Master or a biller tab insert a row. This can happen a few different ways.
a) The Insert Row command
b) Placing cursor in first non-table, blank cell that is underneath last row with data in it, then inputting some data will automatically create a new row.
c) Pressing the Tab key when the cursor is in the last column of the last row of table data, thereby creating a new row.
Regardless how it is done, the counterpart tab must sync and add the row in the correct place. This happens sometimes, but has random failures that I haven't yet pinpointed.
4) Not as important, but deleting rows and having that mirror would also be nice.
Unless someone would like to take a look at my workbook, I will just post the code here. I've tried to remove steps that aren't relevant, but it is very segmented.
The first module runs after workbook is opened and the procedure is called from there. One problem with syncing inserted/deleted rows is knowing how many to add or delete at a time (even though in practice it should just be one).
The above also calls EventStop (obvious reasons) procedure & FindLastCell, which does that on each tab to help calculate and reform UsedRange row count.
After finding the last cell, the second procedure destroys excess UsedRange rows & columns so that my count is accurate.
That's the initialization, but it also runs after other triggers as will be apparent in the following.
Anyway, the brancher procedure determines which other procedure to run, depending on whether the Master or a biller tab needs updating. Most of the code within either the MasterUpdate or AuxUpdate is similar, intended to keep track of row insertions/deletions, and also to keep my counts accurate for future iterations involving oldRowCount or newRowCount (derived from UsedRange).
That, I believe, is the most relevant parts. I will upload my workbook to my Drive as well.
Workbook can be downloaded here.
Scenario: 10 people are using a shared workbook. There are 10 tabs, of which 9 are considered Biller tabs & 1 is the Master tab. The Master tab is just the aggregate of all the Biller tabs, minus the extra header rows. All tabs are using a giant table for all the input data.
The intended task list (not in any order) is:
1) Any of the 9 biller agents enter data on their respective tab, and this is automatically synced to the Master.
2) Likewise, if the Master tab updates something on its tab that is within a specific biller's domain, then that biller tab will sync the new data in the correct cell.
The above steps are not a problem AFAIK, and seem to work fine with my code. The next steps are what have been a problem.
3) Either the Master or a biller tab insert a row. This can happen a few different ways.
a) The Insert Row command
b) Placing cursor in first non-table, blank cell that is underneath last row with data in it, then inputting some data will automatically create a new row.
c) Pressing the Tab key when the cursor is in the last column of the last row of table data, thereby creating a new row.
Regardless how it is done, the counterpart tab must sync and add the row in the correct place. This happens sometimes, but has random failures that I haven't yet pinpointed.
4) Not as important, but deleting rows and having that mirror would also be nice.
Unless someone would like to take a look at my workbook, I will just post the code here. I've tried to remove steps that aren't relevant, but it is very segmented.
The first module runs after workbook is opened and the procedure is called from there. One problem with syncing inserted/deleted rows is knowing how many to add or delete at a time (even though in practice it should just be one).
VBA Code:
Public Sub InitSettings()
Dim ws(0 To 9) As Worksheet
Dim rg(1 To 9) As Range
Dim i As Long
EventStop
FindLastCell
For i = 0 To 9
Set ws(i) = Sheets(Sheets(i + 1).Name)
oldRowCount(i) = ws(i).UsedRange.Rows.Count
Next
EventStart
End SubThe above also calls EventStop (obvious reasons) procedure & FindLastCell, which does that on each tab to help calculate and reform UsedRange row count.
VBA Code:
Sub FindLastCell()
Dim ws(0 To 9) As Worksheet
Dim lCell(0 To 9) As Range
For i = 0 To 9
Set ws(i) = Sheets(Sheets(i + 1).Name)
Set lCell(i) = ws(i).Range("D1048576").End(xlUp).offset(0, 18)
MakeLastCell ws(i), lCell(i)
Next
UsedRangeRowCount
End Sub
Sub MakeLastCell(ByVal Sht As Worksheet, lCell As Range)
'David McRitchie, http://www.mvps.org/dmcritchie/excel/lastcell.htm
Dim x As Integer
Dim str As String
Dim xlong As Long, clong As Long, rlong As Long
On Error GoTo 0
str = lCell.Address
Sht.Range(lCell.row + 1 & ":" & Sht.Cells.Rows.Count).Delete
xlong = Sht.UsedRange.Rows.Count 'Filters can interfere
Sht.Range(Sht.Cells(1, lCell.Column + 1), _
Sht.Cells(Sht.Cells.Rows.Count, Sht.Cells.Columns.Count)).Delete
Beep
xlong = Sht.UsedRange.Rows.Count + Sht.UsedRange.Columns.Count 'Filters can interfere
rlong = Sht.Cells.SpecialCells(xlLastCell).row
clong = Sht.Cells.SpecialCells(xlLastCell).Column
If rlong <= lCell.row And clong <= lCell.Column Then Exit Sub
ActiveWorkbook.Save
xlong = Sht.UsedRange.Rows.Count + Sht.UsedRange.Columns.Count 'Filters can interfere
rlong = Sht.Cells.SpecialCells(xlLastCell).row
clong = Sht.Cells.SpecialCells(xlLastCell).Column
If rlong <= lCell.row And clong <= lCell.Column Then Exit Sub
MsgBox "Sorry, Have failed to make " & str & " your last cell"
End Sub
Public Sub UsedRangeRowCount()
Dim ws(0 To 9) As Worksheet
Dim rg(1 To 9) As Range
Dim i As Long
For i = 0 To 9
Set ws(i) = Sheets(Sheets(i + 1).Name)
oldRowCount(i) = ws(i).UsedRange.Rows.Count
Next
End SubAfter finding the last cell, the second procedure destroys excess UsedRange rows & columns so that my count is accurate.
That's the initialization, but it also runs after other triggers as will be apparent in the following.
VBA Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
EventStop
Brancher Target
EventStart
End Sub
Public Sub Brancher(ByVal Target As Range)
Dim allSht(0 To 9) As Worksheet
Dim newRowCount(0 To 9) As Long
Dim i As Long
Dim rowIns As Long
Dim insOnly As Boolean
Dim addBiller As Boolean
Set allSht(0) = Sheets("Master")
insOnly = False
For i = 0 To 9
Set allSht(i) = Sheets(Sheets(i + 1).Name)
newRowCount(i) = allSht(i).UsedRange.Rows.Count
Next
For i = 0 To 9
If newRowCount(i) <> oldRowCount(i) Then
rowIns = newRowCount(i) - oldRowCount(i)
End If
Next
If rowIns < 0 Then insOnly = True
If Target.Parent Is allSht(0) Then
' AuxUpdate updates biller tabs
oldRowCount(Target.Parent.Index) = newRowCount(Target.Parent.Index) + rowIns
AuxUpdate allSht(0), Target, rowIns, insOnly, addBiller
Else
' MasterUpdate updates only the Master tab
If Target.Column = 1 And Target.Cells.Count < 1000 Then
addBiller = True
Target.offset(0, 3).Value = Target.Parent.Name
End If
oldRowCount(0) = newRowCount(0) + rowIns
MasterUpdate allSht(0), Target, rowIns, insOnly, addBiller
End If
End Sub
Public Sub MasterUpdate(ByVal mSht As Worksheet, ByVal Target As Range, rowIns As Long, insOnly As Boolean, addBiller As Boolean)
Dim tSht As Worksheet
Dim outRng(0 To 8) As Range
Dim outputRng As Range
Dim row As Long
Dim col As Long
Dim offset As Long
Dim rowCh As Long
Dim colLet As String
Dim nameStr(0 To 8) As String
Set tSht = Target.Parent
For i = 0 To 8
nameStr(i) = Sheets(i + 2).Name
If i = 0 Then
Set outRng(i) = mSht.Range("D2")
Else
Set outRng(i) = mSht.Cells.Find(What:=nameStr(i), after:=outRng(i - 1), LookIn:=xlFormulas, lookat:= _
xlPart, searchorder:=xlByRows, searchdirection:=xlNext, MatchCase:=False)
End If
Next
row = Target.row
col = Target.Column
colLet = Number2Letter(col)
Select Case tSht.Name
Case nameStr(0)
offset = row + outRng(0).row
Case nameStr(1)
offset = row + outRng(1).row
Case nameStr(2)
offset = row + outRng(2).row
Case nameStr(3)
offset = row + outRng(3).row
Case nameStr(4)
offset = row + outRng(4).row
Case nameStr(5)
offset = row + outRng(5).row
Case nameStr(6)
offset = row + outRng(6).row
Case nameStr(7)
offset = row + outRng(7).row
Case nameStr(8)
offset = row + outRng(8).row
End Select
offset = offset - 2
Set outputRng = mSht.Range(colLet & (offset))
rowCh = rowIns
Do While rowIns > 0
outputRng.EntireRow.Insert Shift:=xlUp
rowIns = rowIns - 1
Loop
Do While rowIns < 0
outputRng.EntireRow.Delete Shift:=xlUp
rowIns = rowIns + 1
Loop
If insOnly Then GoTo EndSec
If Target.Cells.Count > 1 Then
If Target.Cells.Count > 1000 Then Exit Sub
c = Target.Columns.Count
r = Target.Rows.Count
For i = 1 To r
For j = 1 To c
outputRng.Cells(i, j).Value = Target.Cells(i, j).Value
Next
Next
Else
Set outputRng = outputRng.offset(-rowCh, 0)
outputRng.Value = Target.Value
If addBiller Then
mSht.Range("D" & outputRng.row).Value = tSht.Name
FindLastCell
End If
End If
EndSec:
End Sub
Public Sub AuxUpdate(ByVal mSht As Worksheet, ByVal Target As Range, rowIns As Long, insOnly As Boolean, addBiller As Boolean)
Dim outSht As Worksheet
Dim outRng(0 To 8) As Range
Dim row As Long
Dim col As Long
Dim offset As Long
Dim rowCh As Long
Dim colLet As String
Dim shtName As String
Dim nameStr(0 To 8) As String
For i = 0 To 8
nameStr(i) = Sheets(i + 2).Name
If i = 0 Then
Set outRng(i) = mSht.Range("D2")
Else
Set outRng(i) = mSht.Cells.Find(What:=nameStr(i), after:=outRng(i - 1), LookIn:=xlFormulas, lookat:= _
xlPart, searchorder:=xlByRows, searchdirection:=xlNext, MatchCase:=False)
End If
Next
row = Target.row
Select Case row
Case Is < outRng(1).row
shtName = nameStr(0)
Case Is < outRng(2).row
shtName = nameStr(1)
Case Is < outRng(3).row
shtName = nameStr(2)
Case Is < outRng(4).row
shtName = nameStr(3)
Case Is < outRng(5).row
shtName = nameStr(4)
Case Is < outRng(6).row
shtName = nameStr(5)
Case Is < outRng(7).row
shtName = nameStr(6)
Case Is < outRng(8).row
shtName = nameStr(7)
Case Else
shtName = nameStr(8)
End Select
' shtName = mSht.Range("D" & row).Value
' If shtName = "" Then shtName = mSht.Range("D" & row).offset(1, 0).Value
Set outSht = Sheets(shtName)
col = Target.Column
colLet = Number2Letter(col)
Select Case outSht.Name
Case nameStr(0)
offset = row - outRng(0).row
Case nameStr(1)
offset = row - outRng(1).row
Case nameStr(2)
offset = row - outRng(2).row
Case nameStr(3)
offset = row - outRng(3).row
Case nameStr(4)
offset = row - outRng(4).row
Case nameStr(5)
offset = row - outRng(5).row
Case nameStr(6)
offset = row - outRng(6).row
Case nameStr(7)
offset = row - outRng(7).row
Case nameStr(8)
offset = row - outRng(8).row
End Select
offset = offset + 2
Set outputRng = outSht.Range(colLet & (offset))
rowCh = rowIns
Do While rowIns > 0
outputRng.EntireRow.Insert Shift:=xlUp
rowIns = rowIns - 1
Loop
Do While rowIns < 0
outputRng.EntireRow.Delete Shift:=xlUp
rowIns = rowIns + 1
Loop
If insOnly Then GoTo EndSec
If Target.Cells.Count > 1 Then
' Probably inserted an entire row, so end sub
If Target.Cells.Count > 1000 Then GoTo EndSec
c = Target.Columns.Count
r = Target.Rows.Count
For i = 1 To r
For j = 1 To c
outputRng.Cells(i, j).Value = Target.Cells(i, j).Value
Next
Next
Else
Set outputRng = outputRng.offset(-rowCh, 0)
outputRng.Value = Target.Value
End If
EndSec:
End SubAnyway, the brancher procedure determines which other procedure to run, depending on whether the Master or a biller tab needs updating. Most of the code within either the MasterUpdate or AuxUpdate is similar, intended to keep track of row insertions/deletions, and also to keep my counts accurate for future iterations involving oldRowCount or newRowCount (derived from UsedRange).
That, I believe, is the most relevant parts. I will upload my workbook to my Drive as well.
Workbook can be downloaded here.
