PDA

View Full Version : Cleanup and fix vba code help



jdcaro55
12-28-2011, 01:18 PM
Hello friends,

I was wondering if I can get some help with my code. I am using excel 2010.

First this is my code:

Sub addColumn()

Dim Cell As Range
Dim Earnings As Range
Dim R As Variant
Dim Rng As Range
Dim Wks As Worksheet


For Each Wks In Worksheets
Set Earnings = Wks.Cells.Find("Earnings", , xlValues, xlWhole, xlByRows, xlNext, False)

If Not Earnings Is Nothing Then
Wks.Columns(19).EntireColumn.Insert

Set Earnings = Earnings.Offset(2, 0).CurrentRegion
Set Rng = Earnings.Offset(1, 18).Resize(Earnings.Rows.Count - 2, 1)

R = Rng.Row

' Add formulas to columns "S" and "T"
Rng.Formula = "=IF(J" & R & "=""M"",K" & R & "/12*L" & R & "%,IF(J" & R & "=""A"",K" & R & "/1*L" & R & "%,IF(J" & R & "=""Q"",K" & R & "/4*L" & R & "%,IF(J" & R & "=""SA"",K" & R & "/2*L" & R & "%))))"
Rng.Offset(0, 1).Formula = "=N" & R & "/S" & R

' Change font color in cell in "S" to red if it is outside 5% margin
For Each Cell In Rng
If Cell < Cell.Offset(0, -5) * 0.95 Or Cell > Cell.Offset(0, -5) * 1.05 Then
Cell.Font.ColorIndex = 3 'Red
End If
Next Cell
End If

Next Wks


End Sub

First what I noticed is that it looks like it is not adding the column T, it is just replacing whatever it's in there.

Second I also got a "Run-time error "1004': Application-defined or object-defined error" and I think it might be because on the second tab for example, it found the "Earnings" but there was nothing underneath to calculate.

Third, it also has to do with first tab where it shows earnings, as you can see from the file there are some that would have negative amounts in column N, what I was wondering was if there is a way for it to if it finds a negative lets say, it will search until that client ends and give a SUM of all those values, pretty much not turning the newly created value (column S) red.

Fourthwould be to see whether we can apply the following formula to the newly created column "S" but it would have to first search for the row that shows "Advances" and then jump 2 more lines to the third line, look at the comments in column "Q" and then multiply whatever number amount shows after the "$" sign times "L11%*M11%" in the case of the first tab for example. Also the same formula would apply for the T column.


thanks in advance

Paul_Hossler
12-28-2011, 05:52 PM
1. you can give this a try
2. I didn't see why you wanted to insert columns
3. If the computed data is regenerated each time, you might use VBA to calculate it and just put it in the cells, instead of a formula


Option Explicit
Sub addColumn1()

Dim Cell As Range
Dim Earnings As Range
Dim R As Variant
Dim Rng As Range
Dim Wks As Worksheet


For Each Wks In Worksheets
Set Earnings = Wks.Cells.Find("Earnings", , xlValues, xlWhole, xlByRows, xlNext, False)

If Not Earnings Is Nothing Then

Set Earnings = Earnings.Offset(2, 0).CurrentRegion

If Earnings.Rows.Count > 1 Then

'I didn't see why you wanted to insert
Wks.Range("S:T").Delete

Set Rng = Earnings.Offset(1, 18).Resize(Earnings.Rows.Count - 2, 1)

R = Rng.Row

' Add formulas to columns "S" and "T"
Rng.Formula = "=IF(J" & R & "=""M"",K" & R & "/12*L" & R & "%,IF(J" & R & "=""A"",K" & R & "/1*L" & R & "%,IF(J" & R & "=""Q"",K" & R & "/4*L" & R & "%,IF(J" & R & "=""SA"",K" & R & "/2*L" & R & "%))))"
Rng.Offset(0, 1).Formula = "=N" & R & "/S" & R

' Change font color in cell in "S" to red if it is outside 5% margin
For Each Cell In Rng
If Cell < Cell.Offset(0, -5) * 0.95 Or Cell > Cell.Offset(0, -5) * 1.05 Then
Cell.Font.ColorIndex = 3 'Red
End If
Next Cell
End If
End If

Next Wks


End Sub


Paul

mdmackillop
12-29-2011, 12:36 PM
With regard to the font colour, if your data will change, so will the results. Better to use Conditional Formatting in this case.

jdcaro55
01-26-2012, 12:00 PM
I noticed that this code deletes whatever I have in column S and T instead of adding new columns.

Also would you be able to code it to not add the formula but just the vbcode to get results?

Thanks

Bob Phillips
01-26-2012, 05:20 PM
After the code setting the formula, just fix the values



With Rng

.Formula = "=IF(J" & R & "=""M"",K" & R _
& "/12*L" & R & "%,IF(J" & R & "=""A"",K" _
& R & "/1*L" & R & "%,IF(J" & R & "=""Q"",K" _
& R & "/4*L" & R & "%,IF(J" & R & "=""SA"",K" _
& R & "/2*L" & R & "%))))"
.Value = .Value
End With