‘VBA Excel Macro
‘Name: update_EWR_from_SWE
‘Version: 2011-10-26
‘Author: green-waste (at) 163.com
‘Purpose: find the newly added EWR in constSWEFile, then add them into constEWRtoMergeFile
‘———————————————————————————————–
‘
‘Attribute VB_Name = “update_EWR_from_SWE”
‘Public Const constSWEExcelFile As String = “2011_EWR_tracking_list.xlsx”
Public Const constSWEFile As String = “2011_EWR_tracking_list_testing.xlsx”
‘Public Const constEWRtoMergeFile As String = “EWR_tracking_list.xlsx”
‘Public Const constEWRtoMergeFile As String = “EWR_tracking_list_enabledMacro_testing.xlsm”
Public Const constEWRtoMergeFile As String = “EWR_tracking_list_enabledMacro.xlsm”
Public Const constSrcSheet As String = “Work loads”
Public Const constDestSheet As String = “EWR Date base”
Public Const constSrcColNumber As String = “Number”
Public rowsToMerge(100) As Integer
Public maxRowToMerge As Integer
Public wbSWE, wbEWRtoMerge As Object ‘wb=workbook
Public workloadsSheet, ewrDbSheet As Object ‘ewrDb=EWR data base
Public Enum Issue_Type
‘CAR = “CAR”
CAR
‘EWR = “EWR”
EWR
‘JIRA = “JIRA”
JIRA
End Enum
Function copyCell(destCell As String, srcCell As String)
‘version 1: just copy content
ewrDbSheet.Range(destCell) = workloadsSheet.Range(srcCell)
‘version 2: copy content, apply destination format
‘Windows(constSWEFile).Activate
‘Range(srcCell).Select
‘Selection.Copy
‘Windows(constEWRtoMergeFile).Activate
‘Range(destCell).Select
‘ActiveSheet.Paste
‘ActiveSheet.PasteSpecial(paste:=xlPasteValidation)
‘Range(destCell).PasteSpecial xlPasteValidation, xlPasteSpecialOperationNone
End Function
‘ purpose: in the source excel sheet, find the new added EWR item, add it to the dest excel sheet
Sub update_EWR_from_SWE()
Dim fullName As String
‘Dim colNumber As Object
Dim i, j, k As Integer
Dim wholeRowNum As Long
Dim srcTotalNum, destTotalNum As Integer
Dim srcValue, destValue As Integer
Dim foundCurItem As Boolean
Dim srcMaxIdx, destMaxIdx As Integer
Dim srcRowIdx, destRowIdx As Integer
Dim destAddedIdxStart, destAddedIdxEnd As Integer
Rem —0.make sure you currently is opened the Excel file of EWR to merge—
‘fullName = ActiveWorkbook.Path & “” & constEWRtoMergeFile
‘Set wbEWRtoMerge = Workbooks.Open(fileName:=fullName, UpdateLinks:=xlUpdateLinksAlways)
‘Set wbEWRtoMerge = Workbooks.Open(fileName:=fullName, UpdateLinks:=2)
‘Set wbEWRtoMerge = Workbooks.Open(fileName:=fullName)
‘wbEWRtoMerge.Active
Set wbEWRtoMerge = ActiveWorkbook
‘MsgBox “Active Excel file is:” & wbEWRtoMerge.Name
Rem —1.open xls file—
fullName = ActiveWorkbook.Path & “” & constSWEFile
Set wbSWE = Workbooks.Open(fileName:=fullName, ReadOnly:=True)
‘MsgBox “Open ” & wbSWE.Name & ” OK”
MsgBox “src file=” & constSWEFile & “, dest file=” & constEWRtoMergeFile
Rem —2.get sheet—
‘Set colNumber = wbSWE.Worksheets(1).Columns(3)
‘Set workloadsSheet = wbSWE.Worksheets.Item(constSrcSheet)
‘Set workloadsSheet = wbSWE.Worksheets.Item(1)
Set workloadsSheet = wbSWE.Worksheets(constSrcSheet)
Set ewrDbSheet = wbEWRtoMerge.Worksheets(constDestSheet)
‘Set colNumber = workloadsSheet.Columns(constSrcColNumber)
‘Set colNumber = workloadsSheet.Columns(3)
‘colNumber.Select
‘wholeRowNum = Selection.Count
Rem —3. calc the actual max index for sheet item number—
srcMaxIdx = 2000
destMaxIdx = 2000
For i = 2 To srcMaxIdx ‘the first is header, not valid EWR, so omit it
srcValue = workloadsSheet.Range(“C” & i).Value
If srcValue = 0 Or srcValue = Empty Then
If workloadsSheet.Range(“E” & i).Value <> 0 Then
MsgBox constSWEFile & “: row[” & i & “] is rediculous, for EWR number is null, but summary column is not null!!!”
Else
srcMaxIdx = i – 1
GoTo complete_calc_src_max
End If
End If
Next i
complete_calc_src_max:
For j = 2 To destMaxIdx ‘the first is header, not valid EWR, so omit it
destValue = ewrDbSheet.Range(“C” & j).Value
If destValue = 0 Or destValue = Empty Then
If ewrDbSheet.Range(“D” & j) <> 0 Then
MsgBox constEWRtoMergeFile & “: row[” & j & “] is rediculous, for EWR number is null, but summary column is not null!!!”
Else
destMaxIdx = j – 1
GoTo complete_calc_dest_max
End If
End If
Next j
complete_calc_dest_max:
‘MsgBox “Actual max item: src=” & srcMaxIdx & “, dest=” & destMaxIdx
Rem —4.find the new EWRs—
maxRowToMerge = 0
For i = 2 To srcMaxIdx ‘the first is header, not valid EWR, so omit it
srcValue = workloadsSheet.Range(“C” & i).Value
If srcValue = 0 Or srcValue = Empty Then
GoTo complete_search
End If
‘MsgBox “Row[” & i & “] EWR number=” & srcValue
If workloadsSheet.Rows(i).Hidden = False And srcValue > 0 Then
foundCurItem = False
For j = 2 To destMaxIdx ‘the first is header, not valid EWR, so omit it
destValue = ewrDbSheet.Range(“C” & j).Value
If ewrDbSheet.Rows(j).Hidden = False And destValue > 0 Then
If srcValue = destValue Then
foundCurItem = True
‘MsgBox “Found same EWR=” & srcValue & “, srcRow=” & i & ” destRow=” & j
GoTo continue_next_loop
End If
End If
Next j
If foundCurItem = False Then ‘ if not found, then should add/merge this one
‘save it
rowsToMerge(maxRowToMerge) = i
maxRowToMerge = maxRowToMerge + 1
‘MsgBox “Not found source Row[” & i & “], EWR=” & srcValue & “, should add it!”
End If
End If
continue_next_loop:
Next i
complete_search:
Rem —5. do the update/merge work—
srcTotalNum = workloadsSheet.Range(“A1”).Value
‘MsgBox “Source total number:” & srcTotalNum
destTotalNum = ewrDbSheet.Range(“A1”).Value
‘MsgBox “Destination total number:” & destTotalNum
‘init
destRowIdx = destMaxIdx + 1
destAddedIdxStart = destRowIdx
For i = 0 To maxRowToMerge – 1
srcRowIdx = rowsToMerge(i)
‘ merge items
Call copyCell(“A” & destRowIdx, “A” & srcRowIdx) ‘1
Call copyCell(“B” & destRowIdx, “B” & srcRowIdx) ‘EWR
Call copyCell(“C” & destRowIdx, “C” & srcRowIdx) ‘number
Call copyCell(“D” & destRowIdx, “E” & srcRowIdx) ‘summary
Call copyCell(“I” & destRowIdx, “F” & srcRowIdx) ‘assignee
Call copyCell(“K” & destRowIdx, “G” & srcRowIdx) ‘receive date
Call copyCell(“S” & destRowIdx, “H” & srcRowIdx) ‘status
Call copyCell(“T” & destRowIdx, “I” & srcRowIdx) ‘Milestone
Call copyCell(“O” & destRowIdx, “J” & srcRowIdx) ‘Closed Date
Call copyCell(“U” & destRowIdx, “K” & srcRowIdx) ‘update
Call copyCell(“E” & destRowIdx, “M” & srcRowIdx) ‘Requester
Call copyCell(“F” & destRowIdx, “N” & srcRowIdx) ‘Requester Department
MsgBox “Added source row=” & srcRowIdx & “, EWR=” & workloadsSheet.Range(“C” & srcRowIdx) & ” into dest row=” & destRowIdx
destRowIdx = destRowIdx + 1
Next i
destAddedIdxEnd = destRowIdx – 1
Rem —do clean work—
‘select what we have added rows
Windows(constEWRtoMergeFile).Activate
‘Rows(destAddedIdxStart & “:” & destAddedIdxEnd).Select
ewrDbSheet.Range(destAddedIdxStart & “:” & destAddedIdxEnd).Select
wbEWRtoMerge.Save
wbSWE.Close
End Sub
转载请注明：在路上 » [VBA Excel] update EWR from SWE into whole EWR tracking list v2011-10-26