Code:
Sub UpdateMOAllCustomers()
'------- UPDATE CUSTOMERS TABLE and at the same time update missing info Premise/BP/Ffee BASED ON UNBILL/BILL REPORT FROM SAP
'------- Program uses premise number so makes all the stadistics based on premises not CA
Dim Ano As String, Mes As String, MesRep As String, strSQl As String, strSQ3 As String, AnoPrevS As String, MesPrevS As String
Dim DataRange As String, Y As Double, Franchise As Double, PastFile As Boolean, Activa As String
Dim MesPost As Long, AnoPos As Long, TypeCA As String, Business As Double, MoveOutc As Date, FechaMO As Date
Dim Index As Integer, Duplicate As Integer, DateValidate As Date, DateC As Date, Datemo As Date, MesAnt As Date
Dim xlApp As Excel.Application, xlApp2 As Excel.Application, CopyContract As Double, MoveInT As Date, sheetname As String, sheetname2 As String
Dim xlBook As Workbook, xlBook2 As Workbook
Dim xlSheet As Worksheet, xlSheet2 As Worksheet
Dim CurrentForegroundThreadID As Long
'On Error GoTo ErrHandler
Ano = Forms("DataInput")!InYear
Mes = Forms("DataInput")!InMonth
DateB = Mes & " " & "1, " & Ano
MesPost = Month(DateB)
AnoPos = Year(DateB)
If MesPost = 12 Then
MesPrevS = "1"
AnoPrevS = AnoPos + 1
Else
MesPrevS = MesPost + 1
AnoPrevS = AnoPos
End If
DateC = DateSerial(AnoPrevS, MesPrevS, 1)
Datemo = DateC - 1
MesRep = Format(DateC, "mmm")
MesAnt = Mes & " " & "1, " & Ano
over = DateDiff("d", DateB, Now())
PastFile = False
If over > 60 Then PastFile = True
Path = "S:\GasInc\Call Centre\Billing Operations\Industrial Billing\Billing Status\Unbilled Report & Non billable profile report\Unbilled reports"
Path = Path & " " & AnoPrevS & "\"
NameF = Path & "*" & MesRep & "*.xl*"
SetCurrentDirectoryA "S:\GasInc\Call Centre\Billing Operations\Industrial Billing\Billing Status\Unbilled Report & Non billable profile report\Unbilled reports\"
'---Open the excel file (named as the next month as contains prev month billed) to be loading up in a variable array
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
FileName = Path & FName
Set xlBook = xlApp.Workbooks.Open(FileName, UpdateLinks = xlUpdateLinksNever)
Set xlSheet = xlBook.Worksheets(1)
Debug.Print ActiveSheet.Name
sheetname = ActiveSheet.Name
'---Select Range of data and transfer to Array
TemInst = Range("B5").Value
TemClass = Range("D5").Value
TemMI = Range("I5").Value
Tempty = Range("B6").Value
Call ValidateFormat(TemInst, TemClass, TemMI, Tempty)
If Not OKFile Then Exit Sub
Range("B7").Activate
With xlSheet
LastRow = .Cells.Find(What:="", after:=.Range("B8"), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Row
End With
LastRow = LastRow - 1
DataRange = "$B$7:" & "$I$" & LastRow
TableBillData = Range(DataRange)
xlBook.Close True
xlApp.Quit 'addedd
Set xlBook = Nothing
Set xlSheet = Nothing
Set xlApp = Nothing
FName = Dir
'Set xlApp = Nothing
VarReturn = SysCmd(acSysCmdSetStatus, "Ricky is now looking for Move out")
'Now it will looking for MOVE OUT inside the file JUST FOR CURRENT SITUATIONS
'============================================================ NEW =================================
MesRep1 = Format(Datemo, "mmm")
NameF1 = Path & "*" & MesRep1 & "*.xl*"
Set xlApp2 = CreateObject("Excel.Application")
xlApp2.Visible = True
FileName1 = Path & FName1
Set xlBook2 = xlApp2.Workbooks.Open(FileName1, UpdateLinks = xlUpdateLinksNever)
Set xlSheet2 = xlBook2.Worksheets(1)
'Debug.Print ActiveSheet.Name
'sheetname2 = ActiveSheet.Name
'---Select Range of data and transfer to Array for previous month file
Range("B7").Activate
With xlSheet2
LastRow2 = .Cells.Find(What:="", after:=.Range("B7"), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Row
End With
LastRow2 = LastRow2 - 1
DataRange2 = "$B$7:" & "$I$" & LastRow2
Table2 = Range(DataRange2)
xlBook2.Close True
Set xlBook2 = Nothing
Set xlSheet2 = Nothing
Set xlApp2 = Nothing
For j = 1 To LastRow2 - 6
temp = Table2(j, 1)
If Table2(j, 8) < Datemo Then
VarReturn = SysCmd(acSysCmdSetStatus, " ")
mook = True
found = False
m = 1
Do While mook
'm = 1
If m <= LastRow - 6 Then
If TableBillData(m, 6) <> Table2(j, 6) Then
'Debug.Print m
Else
mook = False
found = True
End If
Else
mook = False
'found = False
End If
m = m + 1
Loop
Else
mi2 = mi2 + 1
'Debug.Print mi2
End If
If Not found Then
If Table2(j, 3) <> "CUSE" Then MoveOutAcc = MoveOutAcc + 1
End If
'Debug.Print "k="; k
VarReturn = SysCmd(acSysCmdSetStatus, "Ricky is updating the Record: " & j - 1 & " of " & LastRow2 - 7)
Next j
MsgBox "Statistics for Transportation and Industrial Accounts have been Updated"
VarReturn = SysCmd(acSysCmdSetStatus, " ")
ErrHandler:
Select Case Err
Case 1004: 'Error 48 The Vlookup does not find a Premise so does not exist in the client base
ErrMsg = "CRITICAL ERROR" & vbCr & "PLEASE OPEN VISUAL WINDOW AND PRESS RESET BUTTON" & vbCr & _
"Press OK to continue or " & " IF NOTHING TO UPDATE THEN press Cancel"
MsgBox ErrMsg, vbCritical
Case 94:
ErrMsg = "Nothing in the enter data fields" & vbCr & "Please post a Year and Month" & vbCr & _
"Press OK to continue or " & " IF NOTHING TO UPDATE THEN press Cancel"
MsgBox ErrMsg, vbCritical
'Case Else:
'ErrMsg = "Unknown Error" & vbCr & "Check all the data was updated" & vbCr & _
'"Press OK to continue or " & " IF NOTHING TO UPDATE THEN press Cancel"
'MsgBox ErrMsg, vbCritical
End Select
MsgBox "Program Run completly"
End Sub