Hi Guys,
I have two List Objects TableA and TableB in two different sheets i.e. sht_Source and sht_Dest in same workbook. There are three common columns in both the tables - Type, OriginCode and DestinationCode. What I am trying to accomplish here is to automatically update TableB based on TableA. Sheet2 in which TableB is present is protected and User is not allowed to add/delete any row on his/her own. User can update values in TableB for columns other than the above three columns.
On sht_Dest activate, following actions need to be performed by Macro:
a) If a combination of Type, OriginCode and DestinationCode is present in TableA but not in TableB - Add new row in TableB and fill values in these three columns based on TableA
b) If a combination of Type, OriginCode and DestinationCode is not present in TableA but present in TableB - Delete that row from TableB
c) If a combination of Type,OriginCode and DestinationCode is present in both tables - Do nothing and ignore that row.
I am just a beginner in VBA and have tried to develop the below code which works fine as of now but I am sure the Experts here will have a much cleaner and robust way to address the situation. Is there a better approach to achieve the above specified objectives and/or optimize the below code?
Thanks for your help in advance.
Here's my code:
I have two List Objects TableA and TableB in two different sheets i.e. sht_Source and sht_Dest in same workbook. There are three common columns in both the tables - Type, OriginCode and DestinationCode. What I am trying to accomplish here is to automatically update TableB based on TableA. Sheet2 in which TableB is present is protected and User is not allowed to add/delete any row on his/her own. User can update values in TableB for columns other than the above three columns.
On sht_Dest activate, following actions need to be performed by Macro:
a) If a combination of Type, OriginCode and DestinationCode is present in TableA but not in TableB - Add new row in TableB and fill values in these three columns based on TableA
b) If a combination of Type, OriginCode and DestinationCode is not present in TableA but present in TableB - Delete that row from TableB
c) If a combination of Type,OriginCode and DestinationCode is present in both tables - Do nothing and ignore that row.
I am just a beginner in VBA and have tried to develop the below code which works fine as of now but I am sure the Experts here will have a much cleaner and robust way to address the situation. Is there a better approach to achieve the above specified objectives and/or optimize the below code?
Thanks for your help in advance.
Here's my code:
Code:
Private Sub Worksheet_Activate()
Dim sSht As Worksheet
Dim dSht As Worksheet
Dim sLO As ListObject
Dim dLO As ListObject
Dim OnDType As String, oAC As String, dAC As String
Dim i As Long, j As Long, col As Long
Dim mFound As Boolean
Dim rng As Range, lastRow As Range
Dim NewData(2)
Application.ScreenUpdating = False
Set sSht = ThisWorkbook.Worksheets("sht_Source")
Set dSht = ThisWorkbook.Worksheets("sht_Routes")
Set sLO = sSht.ListObjects("TableA")
Set dLO = dSht.ListObjects("TableB")
mFound = False
dSht.Unprotect Password:="Open"
'Check and Delete unwanted rows from TableB
With dLO
dLstRow = .ListRows.Count
If dLstRow >= 1 Then
For i = .ListRows.Count To 1 Step -1
OnDType = .ListColumns("Type").DataBodyRange(i)
oAC = .ListColumns("OriginCode").DataBodyRange(i)
dAC = .ListColumns("DestinationCode").DataBodyRange(i)
With sLO
sLstRow = .ListRows.Count
If sLstRow >= 1 Then
For j = .ListRows.Count To 1 Step -1
If .ListColumns("Type").DataBodyRange(j) = OnDType And _
.ListColumns("OriginCode").DataBodyRange(j) = oAC And _
.ListColumns("DestinationCode").DataBodyRange(j) = dAC Then
mFound = True
Exit For
Else
mFound = False
End If
Next j
Else
mFound = False
End If
End With
If mFound = False Then
.ListRows(i).Delete
End If
Next i
End If
End With
'Add missing rows and data in TableB
With sLO
For i = 1 To .ListRows.Count
OnDType = .ListColumns("Type").DataBodyRange(i)
oAC = .ListColumns("OriginCode").DataBodyRange(i)
dAC = .ListColumns("DestinationCode").DataBodyRange(i)
With dLO
For j = 1 To .ListRows.Count
If .ListColumns("Type").DataBodyRange(j) = OnDType And _
.ListColumns("OriginCode").DataBodyRange(j) = oAC And _
.ListColumns("DestinationCode").DataBodyRange(j) = dAC Then
mFound = True
Exit For
Else
mFound = False
End If
Next j
End With
If mFound = False Then
With dLO
If .ListRows.Count > 0 Then
Set lastRow = .ListRows(.ListRows.Count).Range
If Application.CountBlank(lastRow) < lastRow.Columns.Count Then
.ListRows.Add
dLstRow = dLstRow + 1
End If
End If
'Iterate through the last row and populate it with the entries from values()
If .ListRows.Count = 0 Then 'If table is totally empty, set lastRow as first entry
.ListRows.Add Position:=1
Set lastRow = .ListRows(1).Range
Else
Set lastRow = .ListRows(.ListRows.Count).Range
End If
NewData(0) = OnDType
NewData(1) = oAC
NewData(2) = dAC
For col = 1 To 3
If col <= UBound(NewData) + 1 Then lastRow.Cells(1, col) = NewData(col - 1)
Next col
End With
End If
Next i
End With
dSht.Protect Password:="Open"
dSht.Range("A1").Select
ExitHandler:
Application.ScreenUpdating = True
dSht.Protect Password:="Open"
End Sub
In majority of cases when I have to implement solution for Mac & PC, I just push data as JASON to IIS server and have it consumed by java (AM Charts and such) or use web front end, rather than Excel.
Learning day by day.