Need to tailor my macro code.

G

Guest

I have come up with a macro (shown below), that sorts out data that I
download and totals it. The problem is that the macro works for this
particular download but not for the others which change every day. I download
the spreadsheet and at the macro deletes cells, sorts the data for me, splits
it into the 3 companys I am analysing and totals the amount for each of the
companies. However the deleting of cells is fine and sorting them is also
fine. From here I am stuck. Say in the first days spreadsheet there are 1000
values corresponding to one company 2000 to another and 1500 to the other,
this changes daily. The macro needs to recognise a Company name and then
total the values which are in a seperate column corresponding to that
company.

Sub Shortfalls()
'
' Shortfalls Macro
' Macro recorded 12/07/2006 by terminal12
'

'
Columns("E:K").Select
Selection.Delete Shift:=xlToLeft
Columns("J:K").Select
Selection.Delete Shift:=xlToLeft
Columns("M:U").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("F:F").Select
Range("A1:L5622").Sort Key1:=Range("F2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("O7").Select
ActiveCell.FormulaR1C1 = "AA Total"
Range("O8").Select
ActiveCell.FormulaR1C1 = "PR Total"
Range("O9").Select
ActiveCell.FormulaR1C1 = "HY Total"
Range("P7").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-5]C[-12]:R[2049]C[-12])"
Range("P8").Select
ActiveCell.FormulaR1C1 = "=SUM(R[4601]C[-12]:R[5614]C[-12])"
Range("P9").Select
ActiveCell.FormulaR1C1 = "=SUM(R[2048]C[-12]:R[4599]C[-12])"
Range("P10").Select
End Sub


Can anyone help?

Regards

Barry
 
G

Guest

Assume column D contains AA, PR, or HY adjust for actual values if not.

Sub Shortfalls()
'
' Shortfalls Macro
' Macro recorded 12/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("E:K").Delete Shift:=xlToLeft
Columns("J:K").Delete Shift:=xlToLeft
Columns("M:U").Delete Shift:=xlToLeft
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("D2"), _
Cells(Rows.Count, "D").End(xlUp))
For Each cell In rng
Select Case cell.Value
Case "AA"
If cell.Row < min1 Then min1 = cell.Row
If cell.Row > max1 Then max1 = cell.Row
Case "PR"
If cell.Row < min2 Then min2 = cell.Row
If cell.Row > max2 Then max2 = cell.Row
Case "HY"
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


Barry Walker said:
I have come up with a macro (shown below), that sorts out data that I
download and totals it. The problem is that the macro works for this
particular download but not for the others which change every day. I download
the spreadsheet and at the macro deletes cells, sorts the data for me, splits
it into the 3 companys I am analysing and totals the amount for each of the
companies. However the deleting of cells is fine and sorting them is also
fine. From here I am stuck. Say in the first days spreadsheet there are 1000
values corresponding to one company 2000 to another and 1500 to the other,
this changes daily. The macro needs to recognise a Company name and then
total the values which are in a seperate column corresponding to that
company.

Sub Shortfalls()
'
' Shortfalls Macro
' Macro recorded 12/07/2006 by terminal12
'

'
Columns("E:K").Select
Selection.Delete Shift:=xlToLeft
Columns("J:K").Select
Selection.Delete Shift:=xlToLeft
Columns("M:U").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("F:F").Select
Range("A1:L5622").Sort Key1:=Range("F2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("O7").Select
ActiveCell.FormulaR1C1 = "AA Total"
Range("O8").Select
ActiveCell.FormulaR1C1 = "PR Total"
Range("O9").Select
ActiveCell.FormulaR1C1 = "HY Total"
Range("P7").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-5]C[-12]:R[2049]C[-12])"
Range("P8").Select
ActiveCell.FormulaR1C1 = "=SUM(R[4601]C[-12]:R[5614]C[-12])"
Range("P9").Select
ActiveCell.FormulaR1C1 = "=SUM(R[2048]C[-12]:R[4599]C[-12])"
Range("P10").Select
End Sub


Can anyone help?

Regards

Barry
 
G

Guest

cheer's for the reply but it has come up as

#name? in the boxes where the totals for each company are supposed to go?
Any ideas?

Regards

Barry



Tom Ogilvy said:
Assume column D contains AA, PR, or HY adjust for actual values if not.

Sub Shortfalls()
'
' Shortfalls Macro
' Macro recorded 12/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("E:K").Delete Shift:=xlToLeft
Columns("J:K").Delete Shift:=xlToLeft
Columns("M:U").Delete Shift:=xlToLeft
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("D2"), _
Cells(Rows.Count, "D").End(xlUp))
For Each cell In rng
Select Case cell.Value
Case "AA"
If cell.Row < min1 Then min1 = cell.Row
If cell.Row > max1 Then max1 = cell.Row
Case "PR"
If cell.Row < min2 Then min2 = cell.Row
If cell.Row > max2 Then max2 = cell.Row
Case "HY"
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


Barry Walker said:
I have come up with a macro (shown below), that sorts out data that I
download and totals it. The problem is that the macro works for this
particular download but not for the others which change every day. I download
the spreadsheet and at the macro deletes cells, sorts the data for me, splits
it into the 3 companys I am analysing and totals the amount for each of the
companies. However the deleting of cells is fine and sorting them is also
fine. From here I am stuck. Say in the first days spreadsheet there are 1000
values corresponding to one company 2000 to another and 1500 to the other,
this changes daily. The macro needs to recognise a Company name and then
total the values which are in a seperate column corresponding to that
company.

Sub Shortfalls()
'
' Shortfalls Macro
' Macro recorded 12/07/2006 by terminal12
'

'
Columns("E:K").Select
Selection.Delete Shift:=xlToLeft
Columns("J:K").Select
Selection.Delete Shift:=xlToLeft
Columns("M:U").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("F:F").Select
Range("A1:L5622").Sort Key1:=Range("F2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("O7").Select
ActiveCell.FormulaR1C1 = "AA Total"
Range("O8").Select
ActiveCell.FormulaR1C1 = "PR Total"
Range("O9").Select
ActiveCell.FormulaR1C1 = "HY Total"
Range("P7").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-5]C[-12]:R[2049]C[-12])"
Range("P8").Select
ActiveCell.FormulaR1C1 = "=SUM(R[4601]C[-12]:R[5614]C[-12])"
Range("P9").Select
ActiveCell.FormulaR1C1 = "=SUM(R[2048]C[-12]:R[4599]C[-12])"
Range("P10").Select
End Sub


Can anyone help?

Regards

Barry
 
G

Guest

Column D Contains the values that need totalling and column F contains the
company names. I need to total the values for each company.

Regards

Barry

Tom Ogilvy said:
Assume column D contains AA, PR, or HY adjust for actual values if not.

Sub Shortfalls()
'
' Shortfalls Macro
' Macro recorded 12/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("E:K").Delete Shift:=xlToLeft
Columns("J:K").Delete Shift:=xlToLeft
Columns("M:U").Delete Shift:=xlToLeft
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("D2"), _
Cells(Rows.Count, "D").End(xlUp))
For Each cell In rng
Select Case cell.Value
Case "AA"
If cell.Row < min1 Then min1 = cell.Row
If cell.Row > max1 Then max1 = cell.Row
Case "PR"
If cell.Row < min2 Then min2 = cell.Row
If cell.Row > max2 Then max2 = cell.Row
Case "HY"
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


Barry Walker said:
I have come up with a macro (shown below), that sorts out data that I
download and totals it. The problem is that the macro works for this
particular download but not for the others which change every day. I download
the spreadsheet and at the macro deletes cells, sorts the data for me, splits
it into the 3 companys I am analysing and totals the amount for each of the
companies. However the deleting of cells is fine and sorting them is also
fine. From here I am stuck. Say in the first days spreadsheet there are 1000
values corresponding to one company 2000 to another and 1500 to the other,
this changes daily. The macro needs to recognise a Company name and then
total the values which are in a seperate column corresponding to that
company.

Sub Shortfalls()
'
' Shortfalls Macro
' Macro recorded 12/07/2006 by terminal12
'

'
Columns("E:K").Select
Selection.Delete Shift:=xlToLeft
Columns("J:K").Select
Selection.Delete Shift:=xlToLeft
Columns("M:U").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("F:F").Select
Range("A1:L5622").Sort Key1:=Range("F2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("O7").Select
ActiveCell.FormulaR1C1 = "AA Total"
Range("O8").Select
ActiveCell.FormulaR1C1 = "PR Total"
Range("O9").Select
ActiveCell.FormulaR1C1 = "HY Total"
Range("P7").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-5]C[-12]:R[2049]C[-12])"
Range("P8").Select
ActiveCell.FormulaR1C1 = "=SUM(R[4601]C[-12]:R[5614]C[-12])"
Range("P9").Select
ActiveCell.FormulaR1C1 = "=SUM(R[2048]C[-12]:R[4599]C[-12])"
Range("P10").Select
End Sub


Can anyone help?

Regards

Barry
 
G

Guest

My mistake.

try this:

Sub Shortfalls()
'
' Shortfalls Macro
' Macro recorded 12/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("E:K").Delete Shift:=xlToLeft
Columns("J:K").Delete Shift:=xlToLeft
Columns("M:U").Delete Shift:=xlToLeft
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 cell.Value
Case "AA"
If cell.Row < min1 Then min1 = cell.Row
If cell.Row > max1 Then max1 = cell.Row
Case "PR"
If cell.Row < min2 Then min2 = cell.Row
If cell.Row > max2 Then max2 = cell.Row
Case "HY"
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 said:
Column D Contains the values that need totalling and column F contains the
company names. I need to total the values for each company.

Regards

Barry

Tom Ogilvy said:
Assume column D contains AA, PR, or HY adjust for actual values if not.

Sub Shortfalls()
'
' Shortfalls Macro
' Macro recorded 12/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("E:K").Delete Shift:=xlToLeft
Columns("J:K").Delete Shift:=xlToLeft
Columns("M:U").Delete Shift:=xlToLeft
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("D2"), _
Cells(Rows.Count, "D").End(xlUp))
For Each cell In rng
Select Case cell.Value
Case "AA"
If cell.Row < min1 Then min1 = cell.Row
If cell.Row > max1 Then max1 = cell.Row
Case "PR"
If cell.Row < min2 Then min2 = cell.Row
If cell.Row > max2 Then max2 = cell.Row
Case "HY"
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


Barry Walker said:
I have come up with a macro (shown below), that sorts out data that I
download and totals it. The problem is that the macro works for this
particular download but not for the others which change every day. I download
the spreadsheet and at the macro deletes cells, sorts the data for me, splits
it into the 3 companys I am analysing and totals the amount for each of the
companies. However the deleting of cells is fine and sorting them is also
fine. From here I am stuck. Say in the first days spreadsheet there are 1000
values corresponding to one company 2000 to another and 1500 to the other,
this changes daily. The macro needs to recognise a Company name and then
total the values which are in a seperate column corresponding to that
company.

Sub Shortfalls()
'
' Shortfalls Macro
' Macro recorded 12/07/2006 by terminal12
'

'
Columns("E:K").Select
Selection.Delete Shift:=xlToLeft
Columns("J:K").Select
Selection.Delete Shift:=xlToLeft
Columns("M:U").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("F:F").Select
Range("A1:L5622").Sort Key1:=Range("F2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("O7").Select
ActiveCell.FormulaR1C1 = "AA Total"
Range("O8").Select
ActiveCell.FormulaR1C1 = "PR Total"
Range("O9").Select
ActiveCell.FormulaR1C1 = "HY Total"
Range("P7").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-5]C[-12]:R[2049]C[-12])"
Range("P8").Select
ActiveCell.FormulaR1C1 = "=SUM(R[4601]C[-12]:R[5614]C[-12])"
Range("P9").Select
ActiveCell.FormulaR1C1 = "=SUM(R[2048]C[-12]:R[4599]C[-12])"
Range("P10").Select
End Sub


Can anyone help?

Regards

Barry
 
G

Guest

One more thing and i think it will be complete

its still coming up with name error

It think it may be this

AA,HY and PR are abbreviations used but the actual names in column F

are

Allen & Allen
Hyperformance
Prestige

Does this help?
Tom Ogilvy said:
My mistake.

try this:

Sub Shortfalls()
'
' Shortfalls Macro
' Macro recorded 12/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("E:K").Delete Shift:=xlToLeft
Columns("J:K").Delete Shift:=xlToLeft
Columns("M:U").Delete Shift:=xlToLeft
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 cell.Value
Case "AA"
If cell.Row < min1 Then min1 = cell.Row
If cell.Row > max1 Then max1 = cell.Row
Case "PR"
If cell.Row < min2 Then min2 = cell.Row
If cell.Row > max2 Then max2 = cell.Row
Case "HY"
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 said:
Column D Contains the values that need totalling and column F contains the
company names. I need to total the values for each company.

Regards

Barry

Tom Ogilvy said:
Assume column D contains AA, PR, or HY adjust for actual values if not.

Sub Shortfalls()
'
' Shortfalls Macro
' Macro recorded 12/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("E:K").Delete Shift:=xlToLeft
Columns("J:K").Delete Shift:=xlToLeft
Columns("M:U").Delete Shift:=xlToLeft
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("D2"), _
Cells(Rows.Count, "D").End(xlUp))
For Each cell In rng
Select Case cell.Value
Case "AA"
If cell.Row < min1 Then min1 = cell.Row
If cell.Row > max1 Then max1 = cell.Row
Case "PR"
If cell.Row < min2 Then min2 = cell.Row
If cell.Row > max2 Then max2 = cell.Row
Case "HY"
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


:

I have come up with a macro (shown below), that sorts out data that I
download and totals it. The problem is that the macro works for this
particular download but not for the others which change every day. I download
the spreadsheet and at the macro deletes cells, sorts the data for me, splits
it into the 3 companys I am analysing and totals the amount for each of the
companies. However the deleting of cells is fine and sorting them is also
fine. From here I am stuck. Say in the first days spreadsheet there are 1000
values corresponding to one company 2000 to another and 1500 to the other,
this changes daily. The macro needs to recognise a Company name and then
total the values which are in a seperate column corresponding to that
company.

Sub Shortfalls()
'
' Shortfalls Macro
' Macro recorded 12/07/2006 by terminal12
'

'
Columns("E:K").Select
Selection.Delete Shift:=xlToLeft
Columns("J:K").Select
Selection.Delete Shift:=xlToLeft
Columns("M:U").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("F:F").Select
Range("A1:L5622").Sort Key1:=Range("F2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("O7").Select
ActiveCell.FormulaR1C1 = "AA Total"
Range("O8").Select
ActiveCell.FormulaR1C1 = "PR Total"
Range("O9").Select
ActiveCell.FormulaR1C1 = "HY Total"
Range("P7").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-5]C[-12]:R[2049]C[-12])"
Range("P8").Select
ActiveCell.FormulaR1C1 = "=SUM(R[4601]C[-12]:R[5614]C[-12])"
Range("P9").Select
ActiveCell.FormulaR1C1 = "=SUM(R[2048]C[-12]:R[4599]C[-12])"
Range("P10").Select
End Sub


Can anyone help?

Regards

Barry
 
G

Guest

Sure that is exactly what is in the cell?

Anyway:

Sub Shortfalls()
'
' Shortfalls Macro
' Macro recorded 12/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("E:K").Delete Shift:=xlToLeft
Columns("J:K").Delete Shift:=xlToLeft
Columns("M:U").Delete Shift:=xlToLeft
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 & Allen"
If cell.Row < min1 Then min1 = cell.Row
If cell.Row > max1 Then max1 = cell.Row
Case "Prestige"
If cell.Row < min2 Then min2 = cell.Row
If cell.Row > max2 Then max2 = cell.Row
Case "Hyperformance"
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 said:
One more thing and i think it will be complete

its still coming up with name error

It think it may be this

AA,HY and PR are abbreviations used but the actual names in column F

are

Allen & Allen
Hyperformance
Prestige

Does this help?
Tom Ogilvy said:
My mistake.

try this:

Sub Shortfalls()
'
' Shortfalls Macro
' Macro recorded 12/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("E:K").Delete Shift:=xlToLeft
Columns("J:K").Delete Shift:=xlToLeft
Columns("M:U").Delete Shift:=xlToLeft
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 cell.Value
Case "AA"
If cell.Row < min1 Then min1 = cell.Row
If cell.Row > max1 Then max1 = cell.Row
Case "PR"
If cell.Row < min2 Then min2 = cell.Row
If cell.Row > max2 Then max2 = cell.Row
Case "HY"
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 said:
Column D Contains the values that need totalling and column F contains the
company names. I need to total the values for each company.

Regards

Barry

:

Assume column D contains AA, PR, or HY adjust for actual values if not.

Sub Shortfalls()
'
' Shortfalls Macro
' Macro recorded 12/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("E:K").Delete Shift:=xlToLeft
Columns("J:K").Delete Shift:=xlToLeft
Columns("M:U").Delete Shift:=xlToLeft
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("D2"), _
Cells(Rows.Count, "D").End(xlUp))
For Each cell In rng
Select Case cell.Value
Case "AA"
If cell.Row < min1 Then min1 = cell.Row
If cell.Row > max1 Then max1 = cell.Row
Case "PR"
If cell.Row < min2 Then min2 = cell.Row
If cell.Row > max2 Then max2 = cell.Row
Case "HY"
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


:

I have come up with a macro (shown below), that sorts out data that I
download and totals it. The problem is that the macro works for this
particular download but not for the others which change every day. I download
the spreadsheet and at the macro deletes cells, sorts the data for me, splits
it into the 3 companys I am analysing and totals the amount for each of the
companies. However the deleting of cells is fine and sorting them is also
fine. From here I am stuck. Say in the first days spreadsheet there are 1000
values corresponding to one company 2000 to another and 1500 to the other,
this changes daily. The macro needs to recognise a Company name and then
total the values which are in a seperate column corresponding to that
company.

Sub Shortfalls()
'
' Shortfalls Macro
' Macro recorded 12/07/2006 by terminal12
'

'
Columns("E:K").Select
Selection.Delete Shift:=xlToLeft
Columns("J:K").Select
Selection.Delete Shift:=xlToLeft
Columns("M:U").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("F:F").Select
Range("A1:L5622").Sort Key1:=Range("F2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("O7").Select
ActiveCell.FormulaR1C1 = "AA Total"
Range("O8").Select
ActiveCell.FormulaR1C1 = "PR Total"
Range("O9").Select
ActiveCell.FormulaR1C1 = "HY Total"
Range("P7").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-5]C[-12]:R[2049]C[-12])"
Range("P8").Select
ActiveCell.FormulaR1C1 = "=SUM(R[4601]C[-12]:R[5614]C[-12])"
Range("P9").Select
ActiveCell.FormulaR1C1 = "=SUM(R[2048]C[-12]:R[4599]C[-12])"
Range("P10").Select
End Sub


Can anyone help?

Regards

Barry
 
G

Guest

Genius,

Thanks for helping, i'm learning some real good stuff here.

Regards

Barry

Tom Ogilvy said:
Sure that is exactly what is in the cell?

Anyway:

Sub Shortfalls()
'
' Shortfalls Macro
' Macro recorded 12/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("E:K").Delete Shift:=xlToLeft
Columns("J:K").Delete Shift:=xlToLeft
Columns("M:U").Delete Shift:=xlToLeft
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 & Allen"
If cell.Row < min1 Then min1 = cell.Row
If cell.Row > max1 Then max1 = cell.Row
Case "Prestige"
If cell.Row < min2 Then min2 = cell.Row
If cell.Row > max2 Then max2 = cell.Row
Case "Hyperformance"
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 said:
One more thing and i think it will be complete

its still coming up with name error

It think it may be this

AA,HY and PR are abbreviations used but the actual names in column F

are

Allen & Allen
Hyperformance
Prestige

Does this help?
Tom Ogilvy said:
My mistake.

try this:

Sub Shortfalls()
'
' Shortfalls Macro
' Macro recorded 12/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("E:K").Delete Shift:=xlToLeft
Columns("J:K").Delete Shift:=xlToLeft
Columns("M:U").Delete Shift:=xlToLeft
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 cell.Value
Case "AA"
If cell.Row < min1 Then min1 = cell.Row
If cell.Row > max1 Then max1 = cell.Row
Case "PR"
If cell.Row < min2 Then min2 = cell.Row
If cell.Row > max2 Then max2 = cell.Row
Case "HY"
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


:

Column D Contains the values that need totalling and column F contains the
company names. I need to total the values for each company.

Regards

Barry

:

Assume column D contains AA, PR, or HY adjust for actual values if not.

Sub Shortfalls()
'
' Shortfalls Macro
' Macro recorded 12/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("E:K").Delete Shift:=xlToLeft
Columns("J:K").Delete Shift:=xlToLeft
Columns("M:U").Delete Shift:=xlToLeft
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("D2"), _
Cells(Rows.Count, "D").End(xlUp))
For Each cell In rng
Select Case cell.Value
Case "AA"
If cell.Row < min1 Then min1 = cell.Row
If cell.Row > max1 Then max1 = cell.Row
Case "PR"
If cell.Row < min2 Then min2 = cell.Row
If cell.Row > max2 Then max2 = cell.Row
Case "HY"
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


:

I have come up with a macro (shown below), that sorts out data that I
download and totals it. The problem is that the macro works for this
particular download but not for the others which change every day. I download
the spreadsheet and at the macro deletes cells, sorts the data for me, splits
it into the 3 companys I am analysing and totals the amount for each of the
companies. However the deleting of cells is fine and sorting them is also
fine. From here I am stuck. Say in the first days spreadsheet there are 1000
values corresponding to one company 2000 to another and 1500 to the other,
this changes daily. The macro needs to recognise a Company name and then
total the values which are in a seperate column corresponding to that
company.

Sub Shortfalls()
'
' Shortfalls Macro
' Macro recorded 12/07/2006 by terminal12
'

'
Columns("E:K").Select
Selection.Delete Shift:=xlToLeft
Columns("J:K").Select
Selection.Delete Shift:=xlToLeft
Columns("M:U").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("F:F").Select
Range("A1:L5622").Sort Key1:=Range("F2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("O7").Select
ActiveCell.FormulaR1C1 = "AA Total"
Range("O8").Select
ActiveCell.FormulaR1C1 = "PR Total"
Range("O9").Select
ActiveCell.FormulaR1C1 = "HY Total"
Range("P7").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-5]C[-12]:R[2049]C[-12])"
Range("P8").Select
ActiveCell.FormulaR1C1 = "=SUM(R[4601]C[-12]:R[5614]C[-12])"
Range("P9").Select
ActiveCell.FormulaR1C1 = "=SUM(R[2048]C[-12]:R[4599]C[-12])"
Range("P10").Select
End Sub


Can anyone help?

Regards

Barry
 
G

Guest

Tom,

I wonder if you can help me again, the senario is similar to the last one
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.

Can you help me at all?

Thanks again

Barry
 
G

Guest

This is what I have come up with. 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



Regards

Barry
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top