Excel Excel Macro help please

[skycomputing]

Hi

I am trying (without sucess) to write or find a macro that allows me to compare cells in a Excel (2007) spreadsheet.

The macro would work like this

if A1 was the target and A2 was the actual,

If A2 was greater or equal to A1 then A3 would be the differance in green
if A2 was less than 5% of A1 then A3 would be the differance in amber
if A2 was more than 5% of A1 then A3 would be in Red

Practical the result would be this

If the target A1 was 20 and the actual was 30 then A3 would read 10

If the target A1 was 20 and the actual was 19 then A3 would read -1

If the target A1 was 20 and the actual was 15 then A3 would read -5

I hope you understand this and someone can help, I would also need to repeat this for multipical pairs of cells


Please please help

Many Thanks

 

[MACROBEGINNER]

Hi,

i am new to macros and to forums so forgive me if i am breaking rules or anything here.

i am trying to write a macro that scrolls the page up and to the right on each worksheet in the workbook.

here is what i have so far


Sub PageUp()
'
' PageUp Macro
'

'For Each ws in worksheets (array("sheet2", "sheet1")).SmallScroll ToRight:=15
Range("Z5").Select
ActiveSheet.Shapes.Range(Array("Smiley Face 9")).Select
Selection.OnAction = "PageUp"
Range("Z5").Select

End Sub


Please could somebody advise me on how to do this?

Many Thanks

 

[skycomputing]

hi

I do not write macro's as such, but do know that the easiest way to freeze cell's using the freeze comand built into the system, You do not need to use a macro.

To find the comand and it use use the help function built into the excel system

Skycomputing

 

[EvanDavis]

Hi,

i am new to macros and to forums so forgive me if i am breaking rules or anything here.

i am trying to write a macro that scrolls the page up and to the right on each worksheet in the workbook.

here is what i have so far


Sub PageUp()
'
' PageUp Macro
'

'For Each ws in worksheets (array("sheet2", "sheet1")).SmallScroll ToRight:=15
Range("Z5").Select
ActiveSheet.Shapes.Range(Array("Smiley Face 9")).Select
Selection.OnAction = "PageUp"
Range("Z5").Select

End Sub


Please could somebody advise me on how to do this?

Many Thanks

Macrobeginner it would probably be better to start your own thread.

 

[neel_junior]

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Range("C3") Is Nothing Then Exit Sub
On Error GoTo 0
If Not Intersect(Target, Range("C3")) Is Nothing Then

Range("F7").Select
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT((Month=R2C3)*(Location=R3C3)*(Process=RC4)*(Skill_Set=RC1)*(Source_Type<>R2C4)*(Final_Status=R3C4))"
Range("G7").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(SUMPRODUCT((Month=R2C3)*(Location=R3C3)*(Process=RC4)*(Skill_Set=RC1)*(Source_Type<>R2C4)*(Final_Status=R3C4)*(Annual_CTC))/RC[-1]),"""",((SUMPRODUCT((Month=R2C3)*(Location=R3C3)*(Process=RC4)*(Skill_Set=RC1)*(Source_Type<>R2C4)*(Final_Status=R3C4)*(Annual_CTC))/RC[-1])))"
Range("H7").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(SUMPRODUCT((Month=R2C3)*(Location=R3C3)*(Process=RC4)*(Skill_Set=RC1)*(Source_Type<>R2C4)*(Final_Status=R3C4)*(Targeted_Budget))/RC[-2]),"""",((SUMPRODUCT((Month=R2C3)*(Location=R3C3)*(Process=RC4)*(Skill_Set=RC1)*(Source_Type<>R2C4)*(Final_Status=R3C4)*(Targeted_Budget))/RC[-2])))"
Range("I7").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-2]="""","""",IF(ISERROR((RC[-1]-RC[-2])/RC[-1]),0,(RC[-1]-RC[-2])/RC[-1]))"
Range("J7").Select
ActiveCell.FormulaR1C1 = "=IF(ISERROR(RC[-4]*RC[-3]),"""",((RC[-4]*RC[-3])))"
Range("K7").Select
ActiveCell.FormulaR1C1 = "=IF(ISERROR(RC[-5]*RC[-3]),"""",((RC[-5]*RC[-3])))"
Range("L7").Select
ActiveCell.FormulaR1C1 = "=IF(ISERROR(RC[-1]-RC[-2]),"""",((RC[-1]-RC[-2])))"

Range("F7:L7").Select
Selection.Copy

Range(Selection, Selection.End(xlDown)).Select
Range("F7:L50").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("F7:G7").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Range("F7:L50").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B7").Select
Range(Selection, Selection.End(xlToRight)).Select
Range("B7:L50").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("B2:L6").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End If

Range("C2:C3").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 4
End With
With Selection.Interior
.ColorIndex = 5
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Range("A1").Select
End Sub

This macro has been recorded.
I want to put this in loop.
Let me tell how it works first.
Intially it puts the formula from cell F7 to L7
and then it copys the F7toL7 formulas and paste it till row 50.and does a pastes special value.

I want this to be in Loop.First it will put he formula in F7 if D7 in not blank.and do a paste special value.and this should happen for all the formulas till L column.

Please help