Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to sort
I wonder if anyone can help me, the senario is similar to my last one posted "need to tailor macro code" except sorting the column via company is not as simple. I shall explain why. In this column there are reference numbers follower by the name of the company say, 123456FDF78ALLEN 1234RTG5678PREST 123456SFDFDHYPER However sometimes the refereence number is given with spaces between the reference number and company i.e. 123456FDF78 ALLEN this could be 1,2 or 3 spaces Also for PREST sometimes it comes up in the spreadsheet PRESTIGE. I need the macro to basically recognise and sort Via the company name so If it finds ALLEN, HYPER or PREST it the groups it. The code I have done is below but it doesnt seem to work, Its sorts HYPER but not the other 2 Sub Quotelist() ' ' Quotelist Macro ' Macro recorded 13/07/2006 by terminal12 ' ' Dim cell As Range, rng As Range Dim max1 As Long, max2 As Long, max3 As Long Dim min1 As Long, min2 As Long, min3 As Long min1 = 65536 min2 = 65536 min3 = 65536 Columns("B:E").Select Selection.Delete Shift:=xlToLeft Columns("F:F").Select Selection.Delete Shift:=xlToLeft Columns("G:K").Select Selection.Delete Shift:=xlToLeft Columns("A:A").ColumnWidth = 18.71 Range("B1").Select Columns("A:A").ColumnWidth = 22.71 Columns("C:C").ColumnWidth = 14.29 Columns("G:G").ColumnWidth = 12.57 Range("A1").CurrentRegion.Sort _ Key1:=Range("F2"), _ Order1:=xlAscending, _ Header:=xlGuess, _ OrderCustom:=1, _ MatchCase:=False, _ Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("O7").FormulaR1C1 = "AA Total" Range("O8").FormulaR1C1 = "PR Total" Range("O9").FormulaR1C1 = "HY Total" Set rng = Range(Range("F2"), _ Cells(Rows.Count, "F").End(xlUp)) For Each cell In rng Select Case Trim(cell.Value) Case "ALLEN" If cell.Row < min1 Then min1 = cell.Row If cell.Row max1 Then max1 = cell.Row Case " ALLEN" If cell.Row < min1 Then min1 = cell.Row If cell.Row max1 Then max1 = cell.Row Case " ALLEN" If cell.Row < min1 Then min1 = cell.Row If cell.Row max1 Then max1 = cell.Row Case " PREST" If cell.Row < min1 Then min1 = cell.Row If cell.Row max1 Then max1 = cell.Row Case " PREST" If cell.Row < min1 Then min1 = cell.Row If cell.Row max1 Then max1 = cell.Row Case "PREST" If cell.Row < min2 Then min2 = cell.Row If cell.Row max2 Then max2 = cell.Row Case "HYPER" If cell.Row < min3 Then min3 = cell.Row If cell.Row max3 Then max3 = cell.Row Case " HYPER" If cell.Row < min3 Then min3 = cell.Row If cell.Row max3 Then max3 = cell.Row Case " HYPER" If cell.Row < min3 Then min3 = cell.Row If cell.Row max3 Then max3 = cell.Row Case "PRESTIGE" If cell.Row < min3 Then min3 = cell.Row If cell.Row max3 Then max3 = cell.Row Case " PRESTIGE" If cell.Row < min3 Then min3 = cell.Row If cell.Row max3 Then max3 = cell.Row Case " PRESTIGE" If cell.Row < min3 Then min3 = cell.Row If cell.Row max3 Then max3 = cell.Row End Select Next Range("P7").FormulaR1C1 = _ "=SUM(R" & min1 & "C4:R" & max1 & "C4)" Range("P8").FormulaR1C1 = _ "=SUM(R" & min2 & "C4:R" & max2 & "C4)" Range("P9").FormulaR1C1 = _ "=SUM(R" & min3 & "C4:R" & max3 & "C4)" End Sub Can you help me at all? Regards Barry |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to sort
Sub Quotelist()
' ' Quotelist Macro ' Macro recorded 13/07/2006 by terminal12 ' ' Dim cell As Range, rng As Range Dim max1 As Long, max2 As Long, max3 As Long Dim min1 As Long, min2 As Long, min3 As Long min1 = 65536 min2 = 65536 min3 = 65536 Columns("B:E").Select Selection.Delete Shift:=xlToLeft Columns("F:F").Select Selection.Delete Shift:=xlToLeft Columns("G:K").Select Selection.Delete Shift:=xlToLeft Columns("A:A").ColumnWidth = 18.71 Range("B1").Select Columns("A:A").ColumnWidth = 22.71 Columns("C:C").ColumnWidth = 14.29 Columns("G:G").ColumnWidth = 12.57 Range("A1").CurrentRegion.Sort _ Key1:=Range("F2"), _ Order1:=xlAscending, _ Header:=xlGuess, _ OrderCustom:=1, _ MatchCase:=False, _ Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("O7").FormulaR1C1 = "AA Total" Range("O8").FormulaR1C1 = "PR Total" Range("O9").FormulaR1C1 = "HY Total" Set rng = Range(Range("F2"), _ Cells(Rows.Count, "F").End(xlUp)) For Each cell In rng jj = 0 if instr(1,cell,"Hyp",vbtextcompare) then jj = 3 if instr(1,cell,"All",vbTextcompare) then jj = 1 if instr(1,cell,"Pre".vbTextcompare) then jj = 2 Select Case jj Case 1 '"ALLEN" If cell.Row < min1 Then min1 = cell.Row If cell.Row max1 Then max1 = cell.Row Case 2 '"PREST" If cell.Row < min2 Then min2 = cell.Row If cell.Row max2 Then max2 = cell.Row Case 3 ' "HYPER" If cell.Row < min3 Then min3 = cell.Row If cell.Row max3 Then max3 = cell.Row End Select Next Range("P7").FormulaR1C1 = _ "=SUM(R" & min1 & "C4:R" & max1 & "C4)" Range("P8").FormulaR1C1 = _ "=SUM(R" & min2 & "C4:R" & max2 & "C4)" Range("P9").FormulaR1C1 = _ "=SUM(R" & min3 & "C4:R" & max3 & "C4)" End Sub -- Regards, Tom Ogilvy "Barry Walker" wrote: I wonder if anyone can help me, the senario is similar to my last one posted "need to tailor macro code" except sorting the column via company is not as simple. I shall explain why. In this column there are reference numbers follower by the name of the company say, 123456FDF78ALLEN 1234RTG5678PREST 123456SFDFDHYPER However sometimes the refereence number is given with spaces between the reference number and company i.e. 123456FDF78 ALLEN this could be 1,2 or 3 spaces Also for PREST sometimes it comes up in the spreadsheet PRESTIGE. I need the macro to basically recognise and sort Via the company name so If it finds ALLEN, HYPER or PREST it the groups it. The code I have done is below but it doesnt seem to work, Its sorts HYPER but not the other 2 Sub Quotelist() ' ' Quotelist Macro ' Macro recorded 13/07/2006 by terminal12 ' ' Dim cell As Range, rng As Range Dim max1 As Long, max2 As Long, max3 As Long Dim min1 As Long, min2 As Long, min3 As Long min1 = 65536 min2 = 65536 min3 = 65536 Columns("B:E").Select Selection.Delete Shift:=xlToLeft Columns("F:F").Select Selection.Delete Shift:=xlToLeft Columns("G:K").Select Selection.Delete Shift:=xlToLeft Columns("A:A").ColumnWidth = 18.71 Range("B1").Select Columns("A:A").ColumnWidth = 22.71 Columns("C:C").ColumnWidth = 14.29 Columns("G:G").ColumnWidth = 12.57 Range("A1").CurrentRegion.Sort _ Key1:=Range("F2"), _ Order1:=xlAscending, _ Header:=xlGuess, _ OrderCustom:=1, _ MatchCase:=False, _ Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("O7").FormulaR1C1 = "AA Total" Range("O8").FormulaR1C1 = "PR Total" Range("O9").FormulaR1C1 = "HY Total" Set rng = Range(Range("F2"), _ Cells(Rows.Count, "F").End(xlUp)) For Each cell In rng Select Case Trim(cell.Value) Case "ALLEN" If cell.Row < min1 Then min1 = cell.Row If cell.Row max1 Then max1 = cell.Row Case " ALLEN" If cell.Row < min1 Then min1 = cell.Row If cell.Row max1 Then max1 = cell.Row Case " ALLEN" If cell.Row < min1 Then min1 = cell.Row If cell.Row max1 Then max1 = cell.Row Case " PREST" If cell.Row < min1 Then min1 = cell.Row If cell.Row max1 Then max1 = cell.Row Case " PREST" If cell.Row < min1 Then min1 = cell.Row If cell.Row max1 Then max1 = cell.Row Case "PREST" If cell.Row < min2 Then min2 = cell.Row If cell.Row max2 Then max2 = cell.Row Case "HYPER" If cell.Row < min3 Then min3 = cell.Row If cell.Row max3 Then max3 = cell.Row Case " HYPER" If cell.Row < min3 Then min3 = cell.Row If cell.Row max3 Then max3 = cell.Row Case " HYPER" If cell.Row < min3 Then min3 = cell.Row If cell.Row max3 Then max3 = cell.Row Case "PRESTIGE" If cell.Row < min3 Then min3 = cell.Row If cell.Row max3 Then max3 = cell.Row Case " PRESTIGE" If cell.Row < min3 Then min3 = cell.Row If cell.Row max3 Then max3 = cell.Row Case " PRESTIGE" If cell.Row < min3 Then min3 = cell.Row If cell.Row max3 Then max3 = cell.Row End Select Next Range("P7").FormulaR1C1 = _ "=SUM(R" & min1 & "C4:R" & max1 & "C4)" Range("P8").FormulaR1C1 = _ "=SUM(R" & min2 & "C4:R" & max2 & "C4)" Range("P9").FormulaR1C1 = _ "=SUM(R" & min3 & "C4:R" & max3 & "C4)" End Sub Can you help me at all? Regards Barry |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Sort Macro | Excel Discussion (Misc queries) | |||
Macro Help Needed - Excel 2007 - Print Macro with Auto Sort | Excel Worksheet Functions | |||
Using Macro to sort without clicking on macro button | Excel Discussion (Misc queries) | |||
Sort Macro | Excel Discussion (Misc queries) | |||
Sort Macro | Excel Programming |