Hi all,
Still fairly new to excel VBA. I have a project that i have inherited as someone is on an extended leave. My problem is how the data sorts once it is populated, for example it sorts by: Due Date, Customer Name, and Part Number. I need to add a sorting criteria of "Order Number" within that mix but I can't seem to find where in the code the creator seems to be doing this sorting (or if there is some other method that this is being done). I'm sure that I am just overlooking it but i would just appreciate any help on this at all.
Const My_Connection_String2 = "DSN=_Data_01_MSSQL;UID=sqluser;Trusted_Connection=Yes;APP=Microsoft Office 2003;WSID=EMOTEQ_SALES;DATABASE=DATA" Private Sub CommandButton1_Click() Set cnn = CreateObject("ADODB.Connection") cnn.Open My_Connection_String2 Set RS = CreateObject("ADODB.Recordset") sql = "SELECT OEORDLIN_SQL.item_no AS 'Part Number', OEORDLIN_SQL.user_def_fld_5 AS 'Export', ARCUSFIL_SQL.cus_name AS 'Customer', RIGHT(OEORDHDR_SQL.ord_no,5) AS 'Order', OEORDLIN_SQL.qty_ordered AS 'Qty', TIMEDIM_SQL.BusinessDate AS 'SO Date'," sql = sql & " 'prod_sort' = CASE OEORDLIN_SQL.prod_cat" sql = sql & " WHEN 'E' THEN '2 - DRIVE'" sql = sql & " WHEN 'ENC' THEN '3 - ENCODERS'" sql = sql & " WHEN null THEN '4 - OTHER'" sql = sql & " Else '1 - PRODUCTION'" sql = sql & " End" sql = sql & " FROM DATA.dbo.ARCUSFIL_SQL ARCUSFIL_SQL, DATA.dbo.OEORDHDR_SQL OEORDHDR_SQL, DATA.dbo.OEORDLIN_SQL OEORDLIN_SQL, DATA.dbo.TIMEDIM_SQL TIMEDIM_SQL" sql = sql & " WHERE OEORDHDR_SQL.cus_no = ARCUSFIL_SQL.cus_no AND OEORDLIN_SQL.ord_no = OEORDHDR_SQL.ord_no AND OEORDLIN_SQL.ord_type = OEORDHDR_SQL.ord_type AND " sql = sql & "OEORDLIN_SQL.cus_no = ARCUSFIL_SQL.cus_no AND OEORDLIN_SQL.promise_dt = TIMEDIM_SQL.MacolaDate AND ((OEORDHDR_SQL.status<>'L') AND (OEORDHDR_SQL.ord_type<>'Q') AND " monthybooboo = InputBox("Enter Month", , Month(DateAdd("m", 1, Now()))) yearybooboo = InputBox("Enter Year", , Year(DateAdd("m", 1, Now()))) If Not IsNumeric(monthybooboo) Or Not IsNumeric(yearybooboo) Then Exit Sub sql = sql & "(Month(BusinessDate)=" & monthybooboo & ") AND (Year(BusinessDate)=" & yearybooboo & ") AND (OEORDLIN_SQL.item_no Not " sql = sql & "Like '%Freight%' And OEORDLIN_SQL.item_no Not Like '%NRE%' And OEORDLIN_SQL.item_no Not Like 'MISC%' And OEORDLIN_SQL.item_no Not Like '%CREDIT%' And OEORDLIN_SQL.item_no Not Like '%FEE%' ) AND (ARCUSFIL_SQL.loc='1'))" sql = sql & " ORDER BY prod_sort, TIMEDIM_SQL.BusinessDate, Customer , 'Part Number'" 'MsgBox sql RS.Open sql, cnn If Not RS.EOF Then Worksheets("Status Report").Activate ActiveSheet.Cells.Clear topdata = RS.GetRows jr = LBound(topdata, 2) + 2 For j = LBound(topdata, 2) To UBound(topdata, 2) If j > 0 Then If topdata(6, j - 1) <> topdata(6, j) Then ActiveSheet.Range(ActiveSheet.Cells(jr, 1), ActiveSheet.Cells(jr, 11)).Interior.ColorIndex = 15 ActiveSheet.Cells(jr + 1, 1).Value = Right(topdata(6, j), Len(topdata(6, j)) - 4) ActiveSheet.Cells(jr + 1, 1).Font.Bold = True jr = jr + 2 End If Else ActiveSheet.Range(ActiveSheet.Cells(jr, 1), ActiveSheet.Cells(jr, 11)).Interior.ColorIndex = 15 ActiveSheet.Cells(jr + 1, 1).Value = Right(topdata(6, j), Len(topdata(6, j)) - 4) ActiveSheet.Cells(jr + 1, 1).Font.Bold = True jr = jr + 2 End If For i = LBound(topdata, 1) To UBound(topdata, 1) - 1 If i = 5 Then ActiveSheet.Cells(jr, i + 1).Value = Format(Trim(topdata(i, j)), "dd-MMM") Else ActiveSheet.Cells(jr, i + 1).Value = CStr("'" & Trim(topdata(i, j))) End If 'ActiveSheet.Range(ActiveSheet.Cells(jr, 1), ActiveSheet.Cells(jr, 11)).Borders.LineStyle = xlContinuous Next i partnum = topdata(0, j) If Left(partnum, 3) = "904" Or Left(partnum, 3) = "906" Or Left(partnum, 3) = "2-0" Then ActiveSheet.Cells(jr, 7) = CStr("'" & partnum) ActiveSheet.Cells(jr, 8) = CStr("'" & DoGetDesc(partnum)) 'ActiveSheet.Range(ActiveSheet.Cells(jr, 1), ActiveSheet.Cells(jr, 11)).Borders.LineStyle = xlContinuous jr = jr + 1 End If If Not Left(partnum, 3) = "2-0" Then If Not IsNull(DoBOM(partnum)) Then comparray = DoBOM(partnum) For x = 0 To UBound(comparray, 2) ActiveSheet.Cells(jr, 7) = CStr("'" & comparray(0, x)) ActiveSheet.Cells(jr, 8) = CStr("'" & comparray(1, x)) 'ActiveSheet.Range(ActiveSheet.Cells(jr, 1), ActiveSheet.Cells(jr, 11)).Borders.LineStyle = xlContinuous jr = jr + 1 Next x ElseIf Left(partnum, 3) <> "904" And Left(partnum, 3) <> "906" Then ActiveSheet.Cells(jr, 7) = CStr("'" & partnum) ActiveSheet.Cells(jr, 8) = CStr("'" & DoGetDesc(partnum)) 'ActiveSheet.Range(ActiveSheet.Cells(jr, 1), ActiveSheet.Cells(jr, 11)).Borders.LineStyle = xlContinuous jr = jr + 1 End If End If 'ActiveSheet.Range(ActiveSheet.Cells(jr, 1), ActiveSheet.Cells(jr, 11)).Borders.LineStyle = xlNone jr = jr + 1 Next j For i = LBound(topdata, 1) To UBound(topdata, 1) + 4 If i < 6 Then ActiveSheet.Cells(1, i + 1) = RS.Fields(i).Name Else Select Case i Case 6 ActiveSheet.Cells(1, i + 1) = "Item #" Case 7 ActiveSheet.Cells(1, i + 1) = "Part Descrip" Case 8 ActiveSheet.Cells(1, i + 1) = "Due" Case 9 ActiveSheet.Cells(1, i + 1) = "Vendor/area" Case 10 ActiveSheet.Cells(1, i + 1) = "Comments" End Select End If ActiveSheet.Cells(1, i + 1).Font.Bold = True If i < UBound(topdata, 1) + 4 Then ActiveSheet.Columns(i + 1).AutoFit If i = UBound(topdata, 1) + 4 Then ActiveSheet.Columns(i + 1).ColumnWidth = 42 Next i RS.Close Set RS = Nothing Set topdata = Nothing ActiveSheet.Columns("A").EntireColumn.HorizontalAlignment = xlLeft ActiveSheet.Columns("B").EntireColumn.HorizontalAlignment = xlCenter ActiveSheet.Columns("C").EntireColumn.HorizontalAlignment = xlLeft ActiveSheet.Columns("D").EntireColumn.HorizontalAlignment = xlCenter ActiveSheet.Columns("E").EntireColumn.HorizontalAlignment = xlCenter ActiveSheet.Columns("F").EntireColumn.HorizontalAlignment = xlLeft ActiveSheet.Columns("G").EntireColumn.HorizontalAlignment = xlLeft ActiveSheet.Columns("I").EntireColumn.HorizontalAlignment = xlCenter ActiveSheet.Columns("J").EntireColumn.HorizontalAlignment = xlCenter ActiveSheet.Columns("K").EntireColumn.HorizontalAlignment = xlLeft ActiveSheet.PageSetup.CenterHeader = MonthName(monthybooboo) & " Status Report" ActiveSheet.PageSetup.RightFooter = "Page " & "&P" & " of " & "&N& " & MonthName(monthybooboo) & " Status Report" 'ActiveSheet.UsedRange.Borders.LineStyle = xlContinuous MsgBox "Status Report template complete for " & MonthName(monthybooboo) & " " & yearybooboo & "." Else MsgBox "Error - no data found for month selected." End If End Sub
Reply With Quote
