User:Rugan01/sandbox/sample

Private Sub UserForm_Initialize '++                                    +---+  '**********|  Load in Updater via runing this form      |*************************************|30-Sep-2015|****** '++                                    +---+ Application.ScreenUpdating = False

URl1 = "http://www.eia.gov/dnav/pet/pet_sum_snd_d_nus_mbbl_m_cur.htm" TmpURL = URl1 Txt_Petrol.text = GetSheetName(1) Me.CmbArea1.Clear Me.CmbPeriod1.Clear Me.CmbUnit1.Clear HistoryFramHide Call FillElemData(TmpURL, "Drop1", Me.CmbArea1, "DropF", Me.CmbPeriod1, "DropU", Me.CmbUnit1) If Len(sFormName) > 0 Then If gbUpdate Then Set_Criteria Me    If FrmUSEIAPetrol.OptHistory.value = True Then '    If FrmUSEIAPetrol.OptHistory.value = True Then '        RptT = "H" '      Else '        RptT = "L" '      End If ' Call HistoryFramView Set wb = ActiveWorkbook wb.Sheets("Temp").Activate Findstring = Txt_Petrol.value IntLastColumnx = wb.Sheets("Temp").Range("XFA1").End(xlToLeft).Column For Count = IntLastColumnx To 1 Step -1 ColName = ColumnNumberToLetter(Count) Set Rng = wb.Sheets("Temp").Range(ColName & "1:" & ColName & "1000").Find(Findstring,, xlValues, xlWhole) If Not Rng Is Nothing Then '**********| List Available Row Findout for Update |*************************************|20-Oct-2015| Findstring = "LstAvailable" Set Rng = wb.Sheets("Temp").Range(ColName & "1:" & ColName & "1000").Find(Findstring,, xlValues, xlWhole) If Not Rng Is Nothing Then str = Rng.Offset(0, 0).Address StNo = Right(str, Len(str) - InStrRev(str, "$")) + 1 '**********| List Required Row Findout for Update |*************************************|20-Oct-2015| Findstring = "LstRequired" Set Rng = wb.Sheets("Temp").Range(ColName & "1:" & ColName & "1000").Find(Findstring,, xlValues, xlWhole) If Not Rng Is Nothing Then str = Rng.Offset(0, 0).Address EdNo = Right(str, Len(str) - InStrRev(str, "$")) '- 1 '**********| List Available Item Fill for Update |*************************************|20-Oct-2015|****** For Counter = StNo To EdNo - 1 LstAvailable.AddItem wb.Sheets("Temp").Cells(Counter, ColName) Next Counter '**********| List Required Item Fill for Update |*************************************|20-Oct-2015|****** LastRow = wb.Sheets("Temp").UsedRange.row - 1 + wb.Sheets("Temp").UsedRange.Rows.Count EdNo = EdNo + 1 For Counter = EdNo To LastRow If wb.Sheets("Temp").Cells(Counter, ColName) <> "" Then LstRequired.AddItem wb.Sheets("Temp").Cells(Counter, ColName) End If                                    Next Counter '**********| start date and End period Item Fill for Update |*************************************|12-Nov-2015|****** Findstring = "CmbStPeriod" Set Rng = wb.Sheets("Temp").Range(ColName & "1:" & ColName & "1000").Find(Findstring,, xlValues, xlWhole) str = Rng.Offset(1, 0).Address text = Split(Rng.Offset(1, 0), ",") CmbStPeriod.Clear For i = 1 To UBound(text) CmbStPeriod.AddItem text(i) CmbEdPeriod.AddItem text(i) Next i                                     CmbStPeriod.value = Left(CmbEdPeriod.value, InStr(CmbEdPeriod.value, ",") - 1) CmbEdPeriod.value = Right(CmbEdPeriod.value, Len(CmbEdPeriod.value) - InStrRev(CmbEdPeriod.value, ",")) '**********| start date and End period Item Fill for Update |*************************************|12-Nov-2015|******

Else End If                               Else End If                       Else End If              Next Count End If   Else End If End Sub

Sub doCheckTemp(wsData, str1) Set wkobj = ActiveWorkbook blnFlagTemp = False For Each sht In wkobj.Sheets If sht.Name = "Temp" Then Set WsTemp = sht blnFlagTemp = True Exit For End If   Next

If blnFlagTemp = False Then Set WsTemp = Sheets.Add ActiveSheet.Name = "Temp" End If   Findstring = str1 IntLastColumn = WsTemp.Range("XFA1").End(xlToLeft).Column wb.Sheets("Temp").Activate For Count = IntLastColumn To 1 Step -1 ColName = ColumnNumberToLetter(Count) Set Rng = wb.Sheets("Temp").Range(ColName & "1:" & ColName & "2").Find(Findstring,, xlValues, xlWhole) If Not Rng Is Nothing Then wb.Sheets("Temp").Range(ColName & "1").EntireColumn.Delete Else End If      Next Count If Not gbUpdate Then IntLastColumn = WsTemp.Range("XFA1").End(xlToLeft).Column If WsTemp.Cells(1, IntLastColumn).value <> "" Then IntLastColumn = WsTemp.Range("XFA1").End(xlToLeft).Column + 1 Else IntLastColumn = WsTemp.Range("XFA1").End(xlToLeft).Column End If   Else IntLastColumn = WsTemp.Range("XFA1").End(xlToLeft).Column If WsTemp.Cells(1, IntLastColumn).value <> "" Then IntLastColumn = WsTemp.Range("XFA1").End(xlToLeft).Column + 1 Else IntLastColumn = WsTemp.Range("XFA1").End(xlToLeft).Column End If   End If    LastR = 1 WsTemp.Cells(LastR, IntLastColumn).value = "DefineName" WsTemp.Cells(LastR, IntLastColumn).Font.Bold = True WsTemp.Cells(LastR + 1, IntLastColumn).value = str1 LastR = 2 WsTemp.Cells(LastR + 1, IntLastColumn).value = "FormName" WsTemp.Cells(LastR + 1, IntLastColumn).Font.Bold = True WsTemp.Cells(LastR + 2, IntLastColumn).value = FrmUSEIAPetrol.Name LastR = 4 WsTemp.Cells(LastR + 1, IntLastColumn).value = FrmUSEIAPetrol.Txt_Petrol.Name WsTemp.Cells(LastR + 1, IntLastColumn).Font.Bold = True WsTemp.Cells(LastR + 2, IntLastColumn).value = FrmUSEIAPetrol.Txt_Petrol.value LastR = 6 WsTemp.Cells(LastR + 1, IntLastColumn).value = FrmUSEIAPetrol.CmbUnit1.Name WsTemp.Cells(LastR + 1, IntLastColumn).Font.Bold = True WsTemp.Cells(LastR + 2, IntLastColumn).value = FrmUSEIAPetrol.CmbUnit1.value LastR = 8 WsTemp.Cells(LastR + 1, IntLastColumn).value = FrmUSEIAPetrol.OptLatest.Name WsTemp.Cells(LastR + 1, IntLastColumn).Font.Bold = True WsTemp.Cells(LastR + 2, IntLastColumn).value = FrmUSEIAPetrol.OptLatest.value LastR = 10 WsTemp.Cells(LastR + 1, IntLastColumn).value = FrmUSEIAPetrol.OptHistory.Name WsTemp.Cells(LastR + 1, IntLastColumn).Font.Bold = True WsTemp.Cells(LastR + 2, IntLastColumn).value = FrmUSEIAPetrol.OptHistory.value LastR = 12 WsTemp.Cells(LastR + 1, IntLastColumn).value = FrmUSEIAPetrol.OptProduct.Name WsTemp.Cells(LastR + 1, IntLastColumn).Font.Bold = True WsTemp.Cells(LastR + 2, IntLastColumn).value = FrmUSEIAPetrol.OptProduct.value LastR = 14 WsTemp.Cells(LastR + 1, IntLastColumn).value = FrmUSEIAPetrol.OptArea.Name WsTemp.Cells(LastR + 1, IntLastColumn).Font.Bold = True WsTemp.Cells(LastR + 2, IntLastColumn).value = FrmUSEIAPetrol.OptArea.value LastR = 16 WsTemp.Cells(LastR + 1, IntLastColumn).value = FrmUSEIAPetrol.CmbArea1.Name WsTemp.Cells(LastR + 1, IntLastColumn).Font.Bold = True WsTemp.Cells(LastR + 2, IntLastColumn).value = FrmUSEIAPetrol.CmbArea1.value LastR = 18 WsTemp.Cells(LastR + 1, IntLastColumn).value = FrmUSEIAPetrol.CmbPeriod1.Name WsTemp.Cells(LastR + 1, IntLastColumn).Font.Bold = True WsTemp.Cells(LastR + 2, IntLastColumn).value = FrmUSEIAPetrol.CmbPeriod1.value If RptT = "H" Then LastR = 20 WsTemp.Cells(LastR + 1, IntLastColumn).value = FrmUSEIAPetrol.CmbStPeriod.Name WsTemp.Cells(LastR + 1, IntLastColumn).Font.Bold = True WsTemp.Cells(LastR + 2, IntLastColumn).value = "'" & FrmUSEIAPetrol.CmbStPeriod.value '**********| start date and End period Item Fill for Update |*************************************|12-Nov-2015|****** intlst = FrmUSEIAPetrol.CmbStPeriod.ListCount If intlst > 0 Then For icnt = 0 To intlst - 1 WsTemp.Cells(LastR + 2, IntLastColumn).value = WsTemp.Cells(LastR + 2, IntLastColumn).value & "," & FrmUSEIAPetrol.CmbStPeriod.List(icnt) Next icnt Else End If  '**********|  start date and End period Item Fill for Update |*************************************|12-Nov-2015|****** LastR = 22 WsTemp.Cells(LastR + 1, IntLastColumn).value = FrmUSEIAPetrol.CmbEdPeriod.Name WsTemp.Cells(LastR + 1, IntLastColumn).Font.Bold = True WsTemp.Cells(LastR + 2, IntLastColumn).value = "'" & FrmUSEIAPetrol.CmbStPeriod.value & "," & FrmUSEIAPetrol.CmbEdPeriod.value LastR = 24 WsTemp.Cells(LastR + 1, IntLastColumn).value = FrmUSEIAPetrol.LstAvailable.Name WsTemp.Cells(LastR + 1, IntLastColumn).Font.Bold = True LastR = 26 intlst = FrmUSEIAPetrol.LstAvailable.ListCount - 1 If intlst >= 0 Then For icnt = 0 To intlst WsTemp.Cells(LastR, IntLastColumn).value = FrmUSEIAPetrol.LstAvailable.List(icnt) LastR = LastR + 1 LastRR = LastR Next LastR = LastRR Else LastR = 26 End If   WsTemp.Cells(LastR, IntLastColumn).value = FrmUSEIAPetrol.LstRequired.Name WsTemp.Cells(LastR, IntLastColumn).Font.Bold = True LastR = LastR + 1 intlst = FrmUSEIAPetrol.LstRequired.ListCount - 1 If intlst >= 0 Then For icnt = 0 To intlst WsTemp.Cells(LastR, IntLastColumn).value = FrmUSEIAPetrol.LstRequired.List(icnt) LastR = LastR + 1 LastRR = LastR Next icnt LastR = LastRR Else LastR = 26 End If     End If    WsTemp.Visible = xlSheetVeryHidden End Sub

CrudeOIl- Private Sub UserForm_Initialize '++                                    +---+  '**********|  Load in Updater via runing this form      |*************************************|30-Sep-2015|****** '++                                    +---+

Application.ScreenUpdating = False URL2 = "http://www.eia.gov/dnav/pet/pet_crd_crpdn_adc_mbblpd_m.htm" TmpURL = URL2 Txt_CrudeOil.text = GetSheetName(2) Me.CmbUnit2.Clear HistoryFramHide Call FillElemData(TmpURL, "DropF", Me.CmbUnit2) If Len(sFormName) > 0 Then If gbUpdate Then Set_Criteria Me     If FrmUSEIACrude.OptHistory.value = True Then RptT = "H" Else RptT = "L" End If    Call HistoryFramView 'If FrmUSEIACRUDE.OptHistory.value = True Then Set wb = ActiveWorkbook wb.Sheets("Temp").Activate Findstring = Txt_CrudeOil.value IntLastColumnx = wb.Sheets("Temp").Range("XFA1").End(xlToLeft).Column For Count = IntLastColumnx To 1 Step -1 ColName = ColumnNumberToLetter(Count) Set Rng = wb.Sheets("Temp").Range(ColName & "1:" & ColName & "1000").Find(Findstring,, xlValues, xlWhole) If Not Rng Is Nothing Then '**********| List Available Row Findout for Update |*************************************|20-Oct-2015| Findstring = "LstAvailable" Set Rng = wb.Sheets("Temp").Range(ColName & "1:" & ColName & "1000").Find(Findstring,, xlValues, xlWhole) If Not Rng Is Nothing Then str = Rng.Offset(0, 0).Address StNo = Right(str, Len(str) - InStrRev(str, "$")) + 1 '**********| List Required Row Findout for Update |*************************************|20-Oct-2015| Findstring = "LstRequired" Set Rng = wb.Sheets("Temp").Range(ColName & "1:" & ColName & "1000").Find(Findstring,, xlValues, xlWhole) If Not Rng Is Nothing Then str = Rng.Offset(0, 0).Address EdNo = Right(str, Len(str) - InStrRev(str, "$")) '- 1 '**********| List Available Item Fill for Update |*************************************|20-Oct-2015|****** For Counter = StNo To EdNo - 1 LstAvailable.AddItem wb.Sheets("Temp").Cells(Counter, ColName) Next Counter '**********| List Required Item Fill for Update |*************************************|20-Oct-2015|****** LastRow = wb.Sheets("Temp").UsedRange.row - 1 + wb.Sheets("Temp").UsedRange.Rows.Count EdNo = EdNo + 1 For Counter = EdNo To LastRow If wb.Sheets("Temp").Cells(Counter, ColName) <> "" Then LstRequired.AddItem wb.Sheets("Temp").Cells(Counter, ColName) End If                                    Next Counter '**********| start date and End period Item Fill for Update |*************************************|12-Nov-2015|****** Findstring = "CmbStPeriod" Set Rng = wb.Sheets("Temp").Range(ColName & "1:" & ColName & "1000").Find(Findstring,, xlValues, xlWhole) str = Rng.Offset(1, 0).Address text = Split(Rng.Offset(1, 0), ",") CmbStPeriod.Clear For i = 1 To UBound(text) CmbStPeriod.AddItem text(i) CmbEdPeriod.AddItem text(i) Next i                                     CmbStPeriod.value = Left(CmbEdPeriod.value, InStr(CmbEdPeriod.value, ",") - 1) CmbEdPeriod.value = Right(CmbEdPeriod.value, Len(CmbEdPeriod.value) - InStrRev(CmbEdPeriod.value, ",")) '**********| start date and End period Item Fill for Update |*************************************|12-Nov-2015|****** Else End If                               Else End If                       Else End If              Next Count 'End If   Else End If End Sub

Sub doCheckTemp(wsData, str1) Set wkobj = ActiveWorkbook blnFlagTemp = False For Each sht In wkobj.Sheets If sht.Name = "Temp" Then Set WsTemp = sht blnFlagTemp = True Exit For End If   Next

If blnFlagTemp = False Then Set WsTemp = Sheets.Add ActiveSheet.Name = "Temp" End If   Findstring = str1 IntLastColumn = WsTemp.Range("XFA1").End(xlToLeft).Column wb.Sheets("Temp").Activate For Count = IntLastColumn To 1 Step -1 ColName = ColumnNumberToLetter(Count) Set Rng = wb.Sheets("Temp").Range(ColName & "1:" & ColName & "2").Find(Findstring,, xlValues, xlWhole) If Not Rng Is Nothing Then wb.Sheets("Temp").Range(ColName & "1").EntireColumn.Delete Else End If      Next Count If Not gbUpdate Then IntLastColumn = WsTemp.Range("XFA1").End(xlToLeft).Column If WsTemp.Cells(1, IntLastColumn).value <> "" Then IntLastColumn = WsTemp.Range("XFA1").End(xlToLeft).Column + 1 Else IntLastColumn = WsTemp.Range("XFA1").End(xlToLeft).Column End If   Else IntLastColumn = WsTemp.Range("XFA1").End(xlToLeft).Column If WsTemp.Cells(1, IntLastColumn).value <> "" Then IntLastColumn = WsTemp.Range("XFA1").End(xlToLeft).Column + 1 Else IntLastColumn = WsTemp.Range("XFA1").End(xlToLeft).Column End If   End If    LastR = 1 WsTemp.Cells(LastR, IntLastColumn).value = "DefineName" WsTemp.Cells(LastR, IntLastColumn).Font.Bold = True WsTemp.Cells(LastR + 1, IntLastColumn).value = str1 LastR = 2 WsTemp.Cells(LastR + 1, IntLastColumn).value = "FormName" WsTemp.Cells(LastR + 1, IntLastColumn).Font.Bold = True WsTemp.Cells(LastR + 2, IntLastColumn).value = FrmUSEIACrude.Name '4 LastR = 4 WsTemp.Cells(LastR + 1, IntLastColumn).value = FrmUSEIACrude.Txt_CrudeOil.Name WsTemp.Cells(LastR + 1, IntLastColumn).Font.Bold = True WsTemp.Cells(LastR + 2, IntLastColumn).value = FrmUSEIACrude.Txt_CrudeOil.value LastR = 6 WsTemp.Cells(LastR + 1, IntLastColumn).value = FrmUSEIACrude.CmbUnit2.Name WsTemp.Cells(LastR + 1, IntLastColumn).Font.Bold = True WsTemp.Cells(LastR + 2, IntLastColumn).value = FrmUSEIACrude.CmbUnit2.value LastR = 8 WsTemp.Cells(LastR + 1, IntLastColumn).value = FrmUSEIACrude.OptLatest.Name WsTemp.Cells(LastR + 1, IntLastColumn).Font.Bold = True WsTemp.Cells(LastR + 2, IntLastColumn).value = FrmUSEIACrude.OptLatest.value LastR = 10 WsTemp.Cells(LastR + 1, IntLastColumn).value = FrmUSEIACrude.OptHistory.Name WsTemp.Cells(LastR + 1, IntLastColumn).Font.Bold = True WsTemp.Cells(LastR + 2, IntLastColumn).value = FrmUSEIACrude.OptHistory.value If RptT = "H" Then LastR = 12 WsTemp.Cells(LastR + 1, IntLastColumn).value = FrmUSEIACrude.CmbStPeriod.Name WsTemp.Cells(LastR + 1, IntLastColumn).Font.Bold = True WsTemp.Cells(LastR + 2, IntLastColumn).value = "'" & FrmUSEIACrude.CmbStPeriod.value '**********| start date and End period Item Fill for Update |*************************************|12-Nov-2015|****** intlst = FrmUSEIACrude.CmbStPeriod.ListCount If intlst > 0 Then For icnt = 0 To intlst - 1 WsTemp.Cells(LastR + 2, IntLastColumn).value = WsTemp.Cells(LastR + 2, IntLastColumn).value & "," & FrmUSEIACrude.CmbStPeriod.List(icnt) Next icnt Else End If  '**********|  start date and End period Item Fill for Update |*************************************|12-Nov-2015|****** LastR = 14 WsTemp.Cells(LastR + 1, IntLastColumn).value = FrmUSEIACrude.CmbEdPeriod.Name WsTemp.Cells(LastR + 1, IntLastColumn).Font.Bold = True WsTemp.Cells(LastR + 2, IntLastColumn).value = "'" & FrmUSEIACrude.CmbStPeriod.value & "," & FrmUSEIACrude.CmbEdPeriod.value LastR = 16 WsTemp.Cells(LastR + 1, IntLastColumn).value = FrmUSEIACrude.LstAvailable.Name WsTemp.Cells(LastR + 1, IntLastColumn).Font.Bold = True LastR = 18 intlst = FrmUSEIACrude.LstAvailable.ListCount - 1 If intlst >= 0 Then For icnt = 0 To intlst WsTemp.Cells(LastR, IntLastColumn).value = FrmUSEIACrude.LstAvailable.List(icnt) LastR = LastR + 1 LastRR = LastR Next icnt LastR = LastRR Else LastR = 18 End If

WsTemp.Cells(LastR, IntLastColumn).value = FrmUSEIACrude.LstRequired.Name WsTemp.Cells(LastR, IntLastColumn).Font.Bold = True LastR = LastR + 1 intlst = FrmUSEIACrude.LstRequired.ListCount - 1 If intlst >= 0 Then For icnt = 0 To intlst WsTemp.Cells(LastR, IntLastColumn).value = FrmUSEIACrude.LstRequired.List(icnt) LastR = LastR + 1 Next icnt End If Else End If   WsTemp.Visible = xlSheetVeryHidden

End Sub Private Sub DeleteSheet '++                              +---+    '**********|  Delete the Unwanted Excel Sheet   |*******************************|26-Aug-2015|****** '++                              +---+              Dim WSht(1 To 1) As String WSht(1) = TempShtName Application.DisplayAlerts = False For Count = 1 To 1 SheetName = WSht(Count) wb.Sheets(SheetName).Delete Next Count wb.Save wb.Windows(1).Visible = True Set wb = Nothing Application.DisplayAlerts = True End Sub