Calculation based on 2 different columns and 3 different rows

I have attached an example I am having trouble on, I am trying to calculate the tons per quarter on the sheet based off the start year, quarter, and amount of tons. If the total tonnage is less than 50k then it starts on the year and quarter to left of city and is split out by percentages below for 1 year. If it is greater than 100k it is split out by 2 year percentages, greater than 150k it is split out by 3 year percentages. I have a lot of cities that are changing all the time so I want it to automatically adjust when I change total tons and start times. Thanks for the help.

I don't understand. Yera 1 has 8 percentages, so how can that be spread overe 1 year?

Can you post expected results?

I posted the expected results for this example, I want to be able to change the start year and quarter and tonnage total and it to automatically update. Actual sheet goes way beyond 2010. I also fixed the year percentages.

A formula is possible (I am sure), but it will be tricky. Is VBA ok?

VBA is ok, will it be in a new module?

[vba]

Public Sub ProcessData()
Dim i As Long, j As Long, k As Long
Dim iLastRow As Long
Dim iStartCol As Long
Dim cNumCols As Long
Dim iStartRow As Long

With ActiveSheet

iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 8 To iLastRow

iStartCol = Application.Match(.Cells(i, "A").Value, .Rows(6), 0) _
+ .Cells(i, "B").Value - 1

Select Case .Cells(i, "D").Value
Case Is < 50000:
cNumCols = 4
iStartRow = 25
Case Is < 100000:
cNumCols = 8
iStartRow = 18
Case Is < 150000:
cNumCols = 12
iStartRow = 21
Case Is < 200000:
cNumCols = 16
iStartRow = 22
End Select

k = 1
For j = 1 To cNumCols
If .Cells(i, iStartCol + k - 1).Column Mod 5 <> 4 Then
.Cells(i, iStartCol + k - 1).Value = .Cells(i, "D").Value * .Cells(iStartRow, j + 4).Value
Else
.Cells(i, iStartCol + k - 1).FormulaR1C1 = "=SUM(RC[-4]:RC[-1])"
j = j - 1
End If
k = k + 1
Next j
Next i
End With

End Sub
[/vba]

Ho do I get this to work? Sorry for the noob question, thanks for the help. And will it work with lots more cities?

Go to the VBIDE, ALt-F11

Insert a code module, menu Insert>Module

Copy the code into the code-pane that appears

Go back to Excel, ALt-F11

Hit Alt-F8 to get the macro dialog, select ProcessData from the list, and hit Run

If you want more cities, it is baest to reorganise the percentage data and add a name, add a button, and then use this code assigned to the button

[vba]

Public Sub ProcessData()
Dim i As Long, j As Long, k As Long
Dim iLastRow As Long
Dim iStartCol As Long
Dim cNumCols As Long
Dim iStartRow As Long

With ActiveSheet

iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 8 To iLastRow

iStartCol = Application.Match(.Cells(i, "A").Value, .Rows(6), 0) _
+ .Cells(i, "B").Value - 1

Select Case .Cells(i, "D").Value
Case Is < 50000:
cNumCols = 4
iStartRow = Range("Percentages").Row
Case Is < 100000:
cNumCols = 8
iStartRow = Range("Percentages").Row + 2
Case Is < 150000:
cNumCols = 12
iStartRow = Range("Percentages").Row + 4
Case Is < 200000:
cNumCols = 16
iStartRow = Range("Percentages").Row + 6
End Select

k = 1
For j = 1 To cNumCols
If .Cells(i, iStartCol + k - 1).Column Mod 5 <> 4 Then
.Cells(i, iStartCol + k - 1).Value = .Cells(i, "D").Value * .Cells(iStartRow, j + 4).Value
Else
.Cells(i, iStartCol + k - 1).FormulaR1C1 = "=SUM(RC[-4]:RC[-1])"
j = j - 1
End If
k = k + 1
Next j
Next i
End With

End Sub
[/vba]

Here is a sample WB

This is the file that i need this to work for, I sanitized it for confidential reasons. But these are what that actuals should look like, i just cant get the module you sent to work. Where do i define the cities in the code and rename the percentages? Thanks for the help.

Blimey man, that is one of the nastiest spreadsheets I have ever seen.

You should get the percentages ordered, add the name, and adjust the columns as you have moved them.

To be honest, I dont understand the VBA as much as I thought I would. Can you explain what the code is actually doing and I will be able to figure it out. I am really new with VBA. And I know this spreadsheet is dreadful.

I'll do it tomorrow, time for sleep.

Thanks for the help, I actually am taking out the 2007 column so I am starting on 2008 so it will be easier. Thanks

Can anyone help explain the code, so I can use it for my actual sheet? I am a VBA noob

Okay, a bit of context.

First I changed the lookup percentages so that it was ordered by the year number, 1 2, etc.

Then I created an Excel defined name for the first cell of that data, A94, and called it Percentages.

My code design is
- to go down column A, and where there is a year number, look that up against the data in row 1 so that we know which column to start allocating the percentages
- get the quarter number from column B to add the value for the year to get the exact start column
- check the amount to see which of the percentage rows to lookup and also how many to allocate across (4,8,12, etc.)
- then loop the current row from start column for number of columns, allocating the percentage

[vba]

With ActiveSheet
[/vba]

everything will be done to the activesheet

[vba]

iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 4 To iLastRow
[/vba]

calculate the last non-empty row (start at the bottom and work up) and then tun a loop from row 4 to this last row

[vba]

If .Cells(i, "A").Value <> "" Then

iStartCol = Application.Match(.Cells(i, "A").Value, .Rows(1), 0) _
+ .Cells(i, "B").Value - 1
[/vba]

if columns A is not empty, match that value against row 1 to get a start column number and add the quarter number as its start offset

[vba]

Select Case .Cells(i, "D").Value
Case Is < 50000:
cNumCols = 4
iStartRow = Range("Percentages").Row
Case Is < 100000:
cNumCols = 8
iStartRow = Range("Percentages").Row + 2
Case Is < 150000:
cNumCols = 12
iStartRow = Range("Percentages").Row + 4
Case Is < 200000:
cNumCols = 16
iStartRow = Range("Percentages").Row + 6
End Select
[/vba]

then test the value in column D and determine which row of percentages to use and how many to allocate across

[vba]

k = 1
For j = 1 To cNumCols
If .Cells(i, iStartCol + k - 1).Column Mod 5 <> 4 Then
.Cells(i, iStartCol + k - 1).Value = .Cells(i, "D").Value * .Cells(iStartRow, j + 5).Value
Else
.Cells(i, iStartCol + k - 1).FormulaR1C1 = "=SUM(RC[-4]:RC[-1])"
j = j - 1
End If
k = k + 1
[/vba]

then run an inner loop to calculate the amount per percentage using the percentage row we derived earlier, and the number of columns of percentages we allocated (the Mod 5 test is because of the embedded totals, we don't wan't to populate those with a calculated amount, but we do want to create totals - the Else). The k counter is because it is not a contiguous range of cells we populate

Code:

---


                                        Next j
            End If
        Next i
    End With

---

close out the loops and the With