K_Barnett
09-21-2017, 08:48 AM
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
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