Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Need programming PROs help! Quiclk
I have been debugging to see where the value are coming from (3 columns) that
has a zero. Right now the issue is that in the excel sheet, one set of the rows has null value/zero, and I dont know what database returns the zero value. Since there is no documentation, It makes it tuff to locate. Need help quick so any of you pros that are up to the challange I would really apprecaite it. Type SortType Ordered As Integer SortedA As Integer SortedD As Integer End Type Type ColType ColNum As Integer Header As String MinWidth As Double End Type Type ProdType2 ProdName As String Fiscal As Integer Detail As Boolean ProdDet() As String End Type Type RptMemberType Rep() As String Prods() As ProdType2 Div() As String Location() As String End Type Type RptDataType Skip As Boolean Pos As Integer Rep As String Loc As String Div As String Prod As String Detail As Boolean Indent As String FLY As Double FTY As Double FVar As Double FVarPer As Double LYM As Double TYM As Double MVar As Double MVarPer As Double SL As Double SLVar As Double SLVarPer As Double LYNM As Double AFLY As Integer AFTY As Integer AFVar As Integer AFVP As Double AMLY As Integer AMTY As Integer AMVar As Integer AMVP As Double End Type Type FlashBackType Mbrs As RptMemberType Data() As RptDataType ReportType As Integer End Type Public Const MINIMUMINTEGER = 6# Public Const MINIMUMPERCENT = 5# Public Const MINIMUMDOUBLE = 7.5 Const SPACES = " " Dim lstMyProds() As String Public intFlashLevel As Integer Public ReportMembers As RptMemberType Public ReportData() As RptDataType Public Flashback() As FlashBackType Public gstrMyMeasure As String Public gstrMyScenario As String Public gstrMyCompany As String Public gstrMyManager As String Public gintMyCompany As Integer Public blnPMReport As Boolean Public gintReportType As Integer Public gintLastRow As Integer Public gstrTYMonth As String Public gstrLYMonth As String Public gstrLYNextMonth As String Public shtD As Worksheet Public shtA As Worksheet Public shtX As Worksheet Public shtS As Worksheet Dim lstReps() As SortType Dim lstLocs() As SortType Dim lstDivs() As SortType Dim lstPrds() As SortType Public arrMeasures() As Integer Dim intLastSortRow As Integer Dim intSortDat As Integer Public gintOriginalReportType As Integer Public blnDivisionLevel As Boolean Public strDetailHeader As String Sub GetSortMemberLists() Dim i, J, k, L As Integer Set shtS = ThisWorkbook.Worksheets("shtSort") shtS.Activate shtS.Cells.Clear J = UBound(ReportMembers.Rep) ReDim lstReps(J) If J 1 Then L = J - 1 For i = 1 To L lstReps(i).Ordered = i shtS.Cells(i, 1).Value = ReportMembers.Rep(i) shtS.Cells(i, 2).Value = i Next i shtS.Range("A1:B" & CStr(L)).Select selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom For i = 1 To L k = shtS.Cells(i, 2).Value lstReps(k).SortedA = i Next i selection.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom For i = 1 To L k = shtS.Cells(i, 2).Value lstReps(k).SortedD = i Next i lstReps(J).Ordered = J lstReps(J).SortedA = J lstReps(J).SortedD = J Else lstReps(1).Ordered = 1 lstReps(1).SortedA = 1 lstReps(1).SortedD = 1 End If shtS.Cells.Clear J = UBound(ReportMembers.Location) ReDim lstLocs(J) If J 1 Then For i = 1 To J lstLocs(i).Ordered = i shtS.Cells(i, 1).Value = ReportMembers.Location(i) shtS.Cells(i, 2).Value = i Next i shtS.Range("A1:B" & CStr(J)).Select selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom For i = 1 To J k = shtS.Cells(i, 2).Value lstLocs(k).SortedA = i Next i selection.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom For i = 1 To J k = shtS.Cells(i, 2).Value lstLocs(k).SortedD = i Next i Else lstLocs(1).Ordered = 1 lstLocs(1).SortedA = 1 lstLocs(1).SortedD = 1 End If shtS.Cells.Clear J = UBound(ReportMembers.Div) ReDim lstDivs(J) If J 1 Then For i = 1 To J lstDivs(i).Ordered = i shtS.Cells(i, 1).Value = ReportMembers.Div(i) shtS.Cells(i, 2).Value = i Next i shtS.Range("A1:B" & CStr(J)).Select selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom For i = 1 To J k = shtS.Cells(i, 2).Value lstDivs(k).SortedA = i Next i selection.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom For i = 1 To J k = shtS.Cells(i, 2).Value lstDivs(k).SortedD = i Next i Else lstDivs(1).Ordered = 1 lstDivs(1).SortedA = 1 lstDivs(1).SortedD = 1 End If shtS.Cells.Clear J = UBound(ReportMembers.Prods) ReDim lstPrds(J) If J 1 Then For i = 1 To J lstPrds(i).Ordered = i shtS.Cells(i, 1).Value = ReportMembers.Prods(i).ProdName shtS.Cells(i, 2).Value = i Next i shtS.Range("A1:B" & CStr(J)).Select selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom For i = 1 To J k = shtS.Cells(i, 2).Value lstPrds(k).SortedA = i Next i selection.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom For i = 1 To J k = shtS.Cells(i, 2).Value lstPrds(k).SortedD = i Next i Else lstPrds(1).Ordered = 1 lstPrds(1).SortedA = 1 lstPrds(1).SortedD = 1 End If End Sub Sub GetTopMembers() Dim i, J, k As Integer Dim S As Worksheet Set S = ThisWorkbook.Worksheets("Connect") If MyAccess.Prods(1).Access And MyAccess.Prods(2).Access Then strTopProduct = gconALL_SUPPLIERS ElseIf MyAccess.Prods(1).Access Then strTopProduct = MyAccess.Prods(1).Name Else strTopProduct = MyAccess.Prods(2).Name End If S.Cells.Clear i = 1 S.Cells(1, 2).Value = gstrMyCompany S.Cells(1, 3).Value = conTIME S.Cells(1, 4).Value = strTopProduct S.Cells(1, 5).Value = conMEASURES S.Cells(1, 6).Value = conSCENARIO S.Cells(1, 7).Value = conALL_DIVISIONS S.Cells(1, 8).Value = conLOCATION Do While ms.Cells(i, 55).Value < "" S.Cells(i + 1, 1).Value = ms.Cells(i, 55).Value i = i + 1 Loop gblnEssbaseOK = EssbaseSetSheetOptions("Connect", 2, False, "0", True, False, NO_ACCESS, False) gblnEssbaseOK = EssbaseRetrieve(gstrAppBusrev, gstrDBBusrev, "Connect", "", 1, False, "GetTopMembers", False) If gblnEssbaseOK Then ReDim strTopRep(0) For J = 2 To i - 1 If InStr(S.Cells(J, 1).Value, " ") < 1 Then k = k + 1 ReDim Preserve strTopRep(k) strTopRep(k) = S.Cells(J, 1).Value End If Next J End If End Sub Sub RestoreLastReport() Dim i, J, k, L, M As Integer With Flashback(intFlashLevel) gintReportType = .ReportType k = UBound(.Mbrs.Div) ReDim ReportMembers.Div(k) For i = 1 To k ReportMembers.Div(i) = .Mbrs.Div(i) Next i k = UBound(.Mbrs.Location) ReDim ReportMembers.Location(k) For i = 1 To k ReportMembers.Location(i) = .Mbrs.Location(i) Next i k = UBound(.Mbrs.Rep) ReDim ReportMembers.Rep(k) For i = 1 To k ReportMembers.Rep(i) = .Mbrs.Rep(i) Next i k = UBound(.Mbrs.Prods) ReDim ReportMembers.Prods(k) For i = 1 To k If .Mbrs.Prods(i).Detail Then J = UBound(.Mbrs.Prods(i).ProdDet) ReDim ReportMembers.Prods(i).ProdDet(J) For L = 1 To J ReportMembers.Prods(i).ProdDet(L) = .Mbrs.Prods(i).ProdDet(L) Next L End If ReportMembers.Prods(i).Detail = .Mbrs.Prods(i).Detail ReportMembers.Prods(i).Fiscal = .Mbrs.Prods(i).Fiscal ReportMembers.Prods(i).ProdName = .Mbrs.Prods(i).ProdName Next i M = UBound(.Data) ReDim ReportData(M) For i = 1 To M ReportData(i).AFLY = .Data(i).AFLY ReportData(i).AFTY = .Data(i).AFTY ReportData(i).AFVar = .Data(i).AFVar ReportData(i).AFVP = .Data(i).AFVP ReportData(i).AMLY = .Data(i).AMLY ReportData(i).AMTY = .Data(i).AMTY ReportData(i).AMVar = .Data(i).AMVar ReportData(i).AMVP = .Data(i).AMVP ReportData(i).Detail = .Data(i).Detail ReportData(i).Pos = .Data(i).Pos ReportData(i).Div = .Data(i).Div ReportData(i).FLY = .Data(i).FLY ReportData(i).FTY = .Data(i).FTY ReportData(i).FVar = .Data(i).FVar ReportData(i).FVarPer = .Data(i).FVarPer ReportData(i).Indent = .Data(i).Indent ReportData(i).Loc = .Data(i).Loc ReportData(i).LYM = .Data(i).LYM ReportData(i).LYNM = .Data(i).LYNM ReportData(i).MVar = .Data(i).MVar ReportData(i).MVarPer = .Data(i).MVarPer ReportData(i).Prod = .Data(i).Prod ReportData(i).Rep = .Data(i).Rep ReportData(i).Skip = .Data(i).Skip ReportData(i).SL = .Data(i).SL ReportData(i).SLVar = .Data(i).SLVar ReportData(i).SLVarPer = .Data(i).SLVarPer ReportData(i).TYM = .Data(i).TYM Next i End With intFlashLevel = intFlashLevel - 1 ReDim Preserve Flashback(intFlashLevel) If intFlashLevel = 0 Then Toolbars("FlashReport").ToolbarButtons(conFLASHBAC K).Enabled = False End Sub Sub BackUpCurrentFlashReport() Dim i, J, k, L, M As Integer intFlashLevel = intFlashLevel + 1 ReDim Preserve Flashback(intFlashLevel) With Flashback(intFlashLevel) .ReportType = gintReportType k = UBound(ReportMembers.Div) ReDim .Mbrs.Div(k) For i = 1 To k .Mbrs.Div(i) = ReportMembers.Div(i) Next i k = UBound(ReportMembers.Location) ReDim .Mbrs.Location(k) For i = 1 To k .Mbrs.Location(i) = ReportMembers.Location(i) Next i k = UBound(ReportMembers.Rep) ReDim .Mbrs.Rep(k) For i = 1 To k .Mbrs.Rep(i) = ReportMembers.Rep(i) Next i k = UBound(ReportMembers.Prods) ReDim .Mbrs.Prods(k) For i = 1 To k If ReportMembers.Prods(i).Detail Then J = UBound(ReportMembers.Prods(i).ProdDet) ReDim .Mbrs.Prods(i).ProdDet(J) For L = 1 To J .Mbrs.Prods(i).ProdDet(L) = ReportMembers.Prods(i).ProdDet(L) Next L End If .Mbrs.Prods(i).Detail = ReportMembers.Prods(i).Detail .Mbrs.Prods(i).Fiscal = ReportMembers.Prods(i).Fiscal .Mbrs.Prods(i).ProdName = ReportMembers.Prods(i).ProdName Next i M = UBound(ReportData) ReDim .Data(M) For i = 1 To M .Data(i).AFLY = ReportData(i).AFLY .Data(i).AFTY = ReportData(i).AFTY .Data(i).AFVar = ReportData(i).AFVar .Data(i).AFVP = ReportData(i).AFVP .Data(i).AMLY = ReportData(i).AMLY .Data(i).AMTY = ReportData(i).AMTY .Data(i).AMVar = ReportData(i).AMVar .Data(i).AMVP = ReportData(i).AMVP .Data(i).Detail = ReportData(i).Detail .Data(i).Pos = ReportData(i).Pos .Data(i).Div = ReportData(i).Div .Data(i).FLY = ReportData(i).FLY .Data(i).FTY = ReportData(i).FTY .Data(i).FVar = ReportData(i).FVar .Data(i).FVarPer = ReportData(i).FVarPer .Data(i).Indent = ReportData(i).Indent .Data(i).Loc = ReportData(i).Loc .Data(i).LYM = ReportData(i).LYM .Data(i).LYNM = ReportData(i).LYNM .Data(i).MVar = ReportData(i).MVar .Data(i).MVarPer = ReportData(i).MVarPer .Data(i).Prod = ReportData(i).Prod .Data(i).Rep = ReportData(i).Rep .Data(i).Skip = ReportData(i).Skip .Data(i).SL = ReportData(i).SL .Data(i).SLVar = ReportData(i).SLVar .Data(i).SLVarPer = ReportData(i).SLVarPer .Data(i).TYM = ReportData(i).TYM Next i End With End Sub Sub GetAcctOnlyData() Dim i, J, k, ii, jj, kk, intRow As Integer Dim intS, intE, intOffset As Integer Dim blnFnd, blnProceed As Boolean Dim strProd As String Set shtD = ThisWorkbook.Worksheets("Data") Set shtA = ThisWorkbook.Worksheets("shtAddress") shtA.Cells.Clear shtD.Cells.Clear shtD.Cells.Clear GetSortMemberLists If blnPMReport Then shtD.Cells(1, 5).Value = "TYP" shtD.Cells(1, 6).Value = "LYP" Else shtD.Cells(1, 5).Value = "TYC" shtD.Cells(1, 6).Value = "LYC" End If shtD.Cells(1, 7).Value = "TYTD" shtD.Cells(1, 8).Value = "LYTD" intRow = 2 blnProceed = False For i = 1 To UBound(ReportMembers.Rep) For J = 1 To UBound(ReportMembers.Location) For k = 1 To UBound(ReportMembers.Div) For ii = 1 To UBound(ReportMembers.Prods) If ReportMembers.Prods(ii).Detail Then For jj = 1 To UBound(ReportMembers.Prods(ii).ProdDet) shtD.Cells(intRow, 1).Value = ReportMembers.Rep(i) shtD.Cells(intRow, 2).Value = ReportMembers.Location(J) shtD.Cells(intRow, 3).Value = ReportMembers.Div(k) shtD.Cells(intRow, 4).Value = ReportMembers.Prods(ii).ProdDet(jj) shtA.Cells(intRow, 1).Value = UCase(ReportMembers.Rep(i)) shtA.Cells(intRow, 2).Value = UCase(ReportMembers.Location(J)) shtA.Cells(intRow, 3).Value = UCase(ReportMembers.Div(k)) shtA.Cells(intRow, 4).Value = UCase(ReportMembers.Prods(ii).ProdDet(jj)) shtA.Cells(intRow, 5).Value = ReportMembers.Prods(ii).Fiscal shtA.Cells(intRow, 6).Value = "D" shtA.Cells(intRow, 21).Value = i shtA.Cells(intRow, 22).Value = J shtA.Cells(intRow, 23).Value = k shtA.Cells(intRow, 24).Value = ii intRow = intRow + 1 Next jj End If shtD.Cells(intRow, 1).Value = ReportMembers.Rep(i) shtD.Cells(intRow, 2).Value = ReportMembers.Location(J) shtD.Cells(intRow, 3).Value = ReportMembers.Div(k) shtD.Cells(intRow, 4).Value = ReportMembers.Prods(ii).ProdName shtA.Cells(intRow, 1).Value = UCase(ReportMembers.Rep(i)) shtA.Cells(intRow, 2).Value = UCase(ReportMembers.Location(J)) shtA.Cells(intRow, 3).Value = UCase(ReportMembers.Div(k)) shtA.Cells(intRow, 4).Value = UCase(ReportMembers.Prods(ii).ProdName) shtA.Cells(intRow, 5).Value = ReportMembers.Prods(ii).Fiscal shtA.Cells(intRow, 6).Value = "M" shtA.Cells(intRow, 21).Value = i shtA.Cells(intRow, 22).Value = J shtA.Cells(intRow, 23).Value = k shtA.Cells(intRow, 24).Value = ii intRow = intRow + 1 Next ii Next k Next J Next i gblnEssbaseOK = EssbaseSetSheetOptions("Data", 1, True, "0", True, False, "0", True) gblnEssbaseOK = EssbaseRetrieve(gstrAppAccts, gstrDBAccts, "Data", "", 1, False, "GetReportData - Get Account Sold Data", False) If gblnEssbaseOK Then J = 2 kk = 0 Do While J < intRow + 1 If shtD.Cells(J, 1).Value < "" Then kk = kk + 1 End If J = J + 1 Loop ii = 1 k = 0 'Index of ReportData array ReDim ReportData(kk) For i = 2 To J If shtD.Cells(i, 1).Value < "" Then k = k + 1 blnFnd = False Do While Not blnFnd If UCase(shtD.Cells(i, 1).Value) = shtA.Cells(ii, 1).Value Then If UCase(shtD.Cells(i, 2).Value) = shtA.Cells(ii, 2).Value Then If UCase(shtD.Cells(i, 3).Value) = shtA.Cells(ii, 3).Value Then If UCase(shtD.Cells(i, 4).Value) = shtA.Cells(ii, 4).Value Then blnFnd = True If shtA.Cells(ii, 6).Value = "D" Then ReportData(k).Detail = True intOffset = 0 Else ReportData(k).Detail = False intOffset = 1 End If ReportData(k).Pos = ii J = shtA.Cells(ii, 21).Value shtS.Cells(k, 1).Value = lstReps(J).Ordered shtS.Cells(k, 2).Value = lstReps(J).SortedA shtS.Cells(k, 3).Value = lstReps(J).SortedD J = shtA.Cells(ii, 22).Value shtS.Cells(k, 4).Value = lstLocs(J).Ordered shtS.Cells(k, 5).Value = lstLocs(J).SortedA shtS.Cells(k, 6).Value = lstLocs(J).SortedD J = shtA.Cells(ii, 23).Value shtS.Cells(k, 7).Value = lstDivs(J).Ordered shtS.Cells(k, 8).Value = lstDivs(J).SortedA shtS.Cells(k, 9).Value = lstDivs(J).SortedD J = shtA.Cells(ii, 24).Value shtS.Cells(k, 10).Value = lstPrds(J).Ordered * 10 + intOffset shtS.Cells(k, 11).Value = lstPrds(J).SortedA * 10 + intOffset shtS.Cells(k, 12).Value = lstPrds(J).SortedD * 10 + intOffset With ReportData(k) .AMTY = shtD.Cells(i, 5).Value .AMLY = shtD.Cells(i, 6).Value .AFTY = shtD.Cells(i, 7).Value .AFLY = shtD.Cells(i, 8).Value If .AMTY = 0# And .AMLY = 0# And .AFTY = 0# And .AFLY = 0# Then .Skip = True Else .AMVar = .AMTY - .AMLY .AFVar = .AFTY - .AFLY If .AFLY < 0# Then .AFVP = .AFVar / .AFLY Else .AFVP = 0# End If If .AMLY < 0# Then .AMVP = .AMVar / .AMLY Else .AMVP = 0# End If .Skip = False .Rep = shtD.Cells(i, 1).Value .Loc = shtD.Cells(i, 2).Value .Div = shtD.Cells(i, 3).Value If .Detail Then .Prod = " " & shtD.Cells(i, 4).Value Else .Prod = shtD.Cells(i, 4).Value End If End If End With Else ii = ii + 1 End If Else ii = ii + 1 End If Else ii = ii + 1 End If Else ii = ii + 1 End If Loop End If Next i blnProceed = True Else MsgBox "No Account Sold Data Returned", vbOKOnly + vbInformation, "No Data" End If End Sub Sub SendReportDataToFlashReport() Dim i, J As Integer Dim intNumReps As Integer Dim blnDtl As Boolean Dim strRep As String Dim blnNext As Boolean Set rs = ThisWorkbook.Worksheets("FlashReport") rs.Cells.Clear rs.ResetAllPageBreaks J = 4 blnNext = False strRep = "" blnDtl = False shtA.Columns(10).Clear shtA.Columns(11).Clear If gintReportType = 1 Then For i = 1 To UBound(ReportData) With ReportData(i) If .Skip = False Then If .Rep < strRep Then intNumReps = intNumReps + 1 If intNumReps 1 And gblnBreak Then rs.Activate rs.Range("A" & CStr(J)).Select ActiveWindow.SelectedSheets.HPageBreaks.Add Befo=ActiveCell End If shtA.Cells(J, 10).Value = "REP" shtA.Cells(J, 11).Value = .Rep strRep = .Rep J = J + 1 End If shtA.Cells(J, 10).Value = "DAT" rs.Cells(J, 1).Value = .Loc rs.Cells(J, 2).Value = .Div rs.Cells(J, 3).Value = .Prod rs.Cells(J, 4).Value = .FLY rs.Cells(J, 5).Value = .FTY rs.Cells(J, 6).Value = .FVar rs.Cells(J, 7).Value = .FVarPer rs.Cells(J, 8).Value = .AFLY rs.Cells(J, 9).Value = .AFTY rs.Cells(J, 10).Value = .AFVar rs.Cells(J, 11).Value = .AFVP rs.Cells(J, 12).Value = .LYM rs.Cells(J, 13).Value = .TYM rs.Cells(J, 14).Value = .MVar rs.Cells(J, 15).Value = .MVarPer rs.Cells(J, 16).Value = .AMLY rs.Cells(J, 17).Value = .AMTY rs.Cells(J, 18).Value = .AMVar rs.Cells(J, 19).Value = .AMVP |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Need programming PROs help! Quiclk
I forgot to mention the variable which had zeroes in them is rs.Cells(J,
18).Value = .AMVar can u tel me the d/b "TKM" wrote: I have been debugging to see where the value are coming from (3 columns) that has a zero. Right now the issue is that in the excel sheet, one set of the rows has null value/zero, and I dont know what database returns the zero value. Since there is no documentation, It makes it tuff to locate. Need help quick so any of you pros that are up to the challange I would really apprecaite it. Type SortType Ordered As Integer SortedA As Integer SortedD As Integer End Type Type ColType ColNum As Integer Header As String MinWidth As Double End Type Type ProdType2 ProdName As String Fiscal As Integer Detail As Boolean ProdDet() As String End Type Type RptMemberType Rep() As String Prods() As ProdType2 Div() As String Location() As String End Type Type RptDataType Skip As Boolean Pos As Integer Rep As String Loc As String Div As String Prod As String Detail As Boolean Indent As String FLY As Double FTY As Double FVar As Double FVarPer As Double LYM As Double TYM As Double MVar As Double MVarPer As Double SL As Double SLVar As Double SLVarPer As Double LYNM As Double AFLY As Integer AFTY As Integer AFVar As Integer AFVP As Double AMLY As Integer AMTY As Integer AMVar As Integer AMVP As Double End Type Type FlashBackType Mbrs As RptMemberType Data() As RptDataType ReportType As Integer End Type Public Const MINIMUMINTEGER = 6# Public Const MINIMUMPERCENT = 5# Public Const MINIMUMDOUBLE = 7.5 Const SPACES = " " Dim lstMyProds() As String Public intFlashLevel As Integer Public ReportMembers As RptMemberType Public ReportData() As RptDataType Public Flashback() As FlashBackType Public gstrMyMeasure As String Public gstrMyScenario As String Public gstrMyCompany As String Public gstrMyManager As String Public gintMyCompany As Integer Public blnPMReport As Boolean Public gintReportType As Integer Public gintLastRow As Integer Public gstrTYMonth As String Public gstrLYMonth As String Public gstrLYNextMonth As String Public shtD As Worksheet Public shtA As Worksheet Public shtX As Worksheet Public shtS As Worksheet Dim lstReps() As SortType Dim lstLocs() As SortType Dim lstDivs() As SortType Dim lstPrds() As SortType Public arrMeasures() As Integer Dim intLastSortRow As Integer Dim intSortDat As Integer Public gintOriginalReportType As Integer Public blnDivisionLevel As Boolean Public strDetailHeader As String Sub GetSortMemberLists() Dim i, J, k, L As Integer Set shtS = ThisWorkbook.Worksheets("shtSort") shtS.Activate shtS.Cells.Clear J = UBound(ReportMembers.Rep) ReDim lstReps(J) If J 1 Then L = J - 1 For i = 1 To L lstReps(i).Ordered = i shtS.Cells(i, 1).Value = ReportMembers.Rep(i) shtS.Cells(i, 2).Value = i Next i shtS.Range("A1:B" & CStr(L)).Select selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom For i = 1 To L k = shtS.Cells(i, 2).Value lstReps(k).SortedA = i Next i selection.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom For i = 1 To L k = shtS.Cells(i, 2).Value lstReps(k).SortedD = i Next i lstReps(J).Ordered = J lstReps(J).SortedA = J lstReps(J).SortedD = J Else lstReps(1).Ordered = 1 lstReps(1).SortedA = 1 lstReps(1).SortedD = 1 End If shtS.Cells.Clear J = UBound(ReportMembers.Location) ReDim lstLocs(J) If J 1 Then For i = 1 To J lstLocs(i).Ordered = i shtS.Cells(i, 1).Value = ReportMembers.Location(i) shtS.Cells(i, 2).Value = i Next i shtS.Range("A1:B" & CStr(J)).Select selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom For i = 1 To J k = shtS.Cells(i, 2).Value lstLocs(k).SortedA = i Next i selection.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom For i = 1 To J k = shtS.Cells(i, 2).Value lstLocs(k).SortedD = i Next i Else lstLocs(1).Ordered = 1 lstLocs(1).SortedA = 1 lstLocs(1).SortedD = 1 End If shtS.Cells.Clear J = UBound(ReportMembers.Div) ReDim lstDivs(J) If J 1 Then For i = 1 To J lstDivs(i).Ordered = i shtS.Cells(i, 1).Value = ReportMembers.Div(i) shtS.Cells(i, 2).Value = i Next i shtS.Range("A1:B" & CStr(J)).Select selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom For i = 1 To J k = shtS.Cells(i, 2).Value lstDivs(k).SortedA = i Next i selection.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom For i = 1 To J k = shtS.Cells(i, 2).Value lstDivs(k).SortedD = i Next i Else lstDivs(1).Ordered = 1 lstDivs(1).SortedA = 1 lstDivs(1).SortedD = 1 End If shtS.Cells.Clear J = UBound(ReportMembers.Prods) ReDim lstPrds(J) If J 1 Then For i = 1 To J lstPrds(i).Ordered = i shtS.Cells(i, 1).Value = ReportMembers.Prods(i).ProdName shtS.Cells(i, 2).Value = i Next i shtS.Range("A1:B" & CStr(J)).Select selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom For i = 1 To J k = shtS.Cells(i, 2).Value lstPrds(k).SortedA = i Next i selection.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom For i = 1 To J k = shtS.Cells(i, 2).Value lstPrds(k).SortedD = i Next i Else lstPrds(1).Ordered = 1 lstPrds(1).SortedA = 1 lstPrds(1).SortedD = 1 End If End Sub Sub GetTopMembers() Dim i, J, k As Integer Dim S As Worksheet Set S = ThisWorkbook.Worksheets("Connect") If MyAccess.Prods(1).Access And MyAccess.Prods(2).Access Then strTopProduct = gconALL_SUPPLIERS ElseIf MyAccess.Prods(1).Access Then strTopProduct = MyAccess.Prods(1).Name Else strTopProduct = MyAccess.Prods(2).Name End If S.Cells.Clear i = 1 S.Cells(1, 2).Value = gstrMyCompany S.Cells(1, 3).Value = conTIME S.Cells(1, 4).Value = strTopProduct S.Cells(1, 5).Value = conMEASURES S.Cells(1, 6).Value = conSCENARIO S.Cells(1, 7).Value = conALL_DIVISIONS S.Cells(1, 8).Value = conLOCATION Do While ms.Cells(i, 55).Value < "" S.Cells(i + 1, 1).Value = ms.Cells(i, 55).Value i = i + 1 Loop gblnEssbaseOK = EssbaseSetSheetOptions("Connect", 2, False, "0", True, False, NO_ACCESS, False) gblnEssbaseOK = EssbaseRetrieve(gstrAppBusrev, gstrDBBusrev, "Connect", "", 1, False, "GetTopMembers", False) If gblnEssbaseOK Then ReDim strTopRep(0) For J = 2 To i - 1 If InStr(S.Cells(J, 1).Value, " ") < 1 Then k = k + 1 ReDim Preserve strTopRep(k) strTopRep(k) = S.Cells(J, 1).Value End If Next J End If End Sub Sub RestoreLastReport() Dim i, J, k, L, M As Integer With Flashback(intFlashLevel) gintReportType = .ReportType k = UBound(.Mbrs.Div) ReDim ReportMembers.Div(k) For i = 1 To k ReportMembers.Div(i) = .Mbrs.Div(i) Next i k = UBound(.Mbrs.Location) ReDim ReportMembers.Location(k) For i = 1 To k ReportMembers.Location(i) = .Mbrs.Location(i) Next i k = UBound(.Mbrs.Rep) ReDim ReportMembers.Rep(k) For i = 1 To k ReportMembers.Rep(i) = .Mbrs.Rep(i) Next i k = UBound(.Mbrs.Prods) ReDim ReportMembers.Prods(k) For i = 1 To k If .Mbrs.Prods(i).Detail Then J = UBound(.Mbrs.Prods(i).ProdDet) ReDim ReportMembers.Prods(i).ProdDet(J) For L = 1 To J ReportMembers.Prods(i).ProdDet(L) = .Mbrs.Prods(i).ProdDet(L) Next L End If ReportMembers.Prods(i).Detail = .Mbrs.Prods(i).Detail ReportMembers.Prods(i).Fiscal = .Mbrs.Prods(i).Fiscal ReportMembers.Prods(i).ProdName = .Mbrs.Prods(i).ProdName Next i M = UBound(.Data) ReDim ReportData(M) For i = 1 To M ReportData(i).AFLY = .Data(i).AFLY ReportData(i).AFTY = .Data(i).AFTY ReportData(i).AFVar = .Data(i).AFVar ReportData(i).AFVP = .Data(i).AFVP ReportData(i).AMLY = .Data(i).AMLY ReportData(i).AMTY = .Data(i).AMTY ReportData(i).AMVar = .Data(i).AMVar ReportData(i).AMVP = .Data(i).AMVP ReportData(i).Detail = .Data(i).Detail |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Easy one for you pros! | Excel Worksheet Functions | |||
Easy one for the Pros! | Excel Worksheet Functions | |||
Pros need help | Excel Programming | |||
So close and yet... (Pros Only) | Excel Programming | |||
Excel as a development Platform? pros and cons? | Excel Programming |