Advice for worksheet calculation

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,832
Office Version
  1. 2007
Platform
  1. Windows
Afternoon.

On my worksheet i type in values but when i type REFUND "only ever in a column C cell" the text is automatically turned red & also in the row in question at cell D i see in red £0.00
I then continue to enter the refund value in this cell so when i type £50.00 it then turns to -£50.00

So far all looks good.

The cell K33 shows the current profit to date BUT what i have noticed is that even though the refund as mentioned above shows -£50.00 is doesnt deduct that value from what was currently shown in cell K33 but it adds to that value.

The sheet code is shown below BUT i dont see anything there that relates to this.

Looking at the conditioning format code "manage rules" i only see the following,
=$B4="REFUND"

=$B$4:$B$25,$B$27:$B$28,$C$4:$K$28

So i am a little lost as to how the code knows whether to - / + from cell K33

I HAVE ADDED A WORKSHEET FOR YOU TO LOOK AT PLEASE SELECT TAB EXPENSES1

http://www.mediafire.com/file/h7zjgtczd8ndm3r/ACCOUNTS.zip/file

Code:
Private Sub CommandButton1_Click()  Sheets("EXPENSES (2)").Range("D4").Value = Sheets("EXPENSES (1)").Range("D30").Value
  Sheets("EXPENSES (2)").Range("F4:K4").Value = Sheets("EXPENSES (1)").Range("F30:K30").Value
  Sheets("EXPENSES (2)").Activate
  ActiveSheet.Range("A5").Select
  If Sheets("EXPENSES (2)").Range("K32").Value <> Sheets("EXPENSES (1)").Range("K32").Value Then MsgBox "Balance of sheets incorrect", vbCritical, "K32 CELLS DO NOT MATCH"
End Sub
Private Sub CommandButton2_Click()
Dim Answer As Long, wb As Workbook
    Answer = MsgBox("Transfer Values To Summary Sheet ?", vbYesNo + vbInformation, "End Of Month Accounts")
    If Answer = vbYes Then
        Set wb = Workbooks.Open(Filename:="C:\Users\Ian\Desktop\EBAY\ACCOUNTS\CURRENT SHEETS\SUMMARY SHEET.xlsm")
        Workbooks("ACCOUNTS.xlsm").Sheets("EXPENSES (1)").Range("D30").Copy
        wb.Sheets("Sheet1").Range("I28").PasteSpecial xlPasteValues
        
        Workbooks("ACCOUNTS.xlsm").Sheets("EXPENSES (1)").Range("F30").Copy
        wb.Sheets("Sheet1").Range("I29").PasteSpecial xlPasteValues
        
        Workbooks("ACCOUNTS.xlsm").Sheets("EXPENSES (1)").Range("G30").Copy
        wb.Sheets("Sheet1").Range("I30").PasteSpecial xlPasteValues
        
        Workbooks("ACCOUNTS.xlsm").Sheets("EXPENSES (1)").Range("H30").Copy
        wb.Sheets("Sheet1").Range("I31").PasteSpecial xlPasteValues
        
        Workbooks("ACCOUNTS.xlsm").Sheets("EXPENSES (1)").Range("I30").Copy
        wb.Sheets("Sheet1").Range("I32").PasteSpecial xlPasteValues
        
        Workbooks("ACCOUNTS.xlsm").Sheets("EXPENSES (1)").Range("J30").Copy
        wb.Sheets("Sheet1").Range("I33").PasteSpecial xlPasteValues
        
        Workbooks("ACCOUNTS.xlsm").Sheets("EXPENSES (1)").Range("K30").Copy
        wb.Sheets("Sheet1").Range("I34").PasteSpecial xlPasteValues
        wb.Close True


        End If
        Workbooks("ACCOUNTS.xlsm").Sheets("EXPENSES (1)").Range("A4").Select
        Application.CutCopyMode = False
        MsgBox "Summary Transfer Completed", vbInformation, "SUCCESSFUL MESSAGE"
        ActiveWorkbook.Save
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim myStartCol As String
    Dim myEndCol As String
    Dim myStartRow As Long
    Dim myLastRow As Long
    Dim myRange As Range


    If Target.Cells.Count > 1 Then Exit Sub
    
    Application.ScreenUpdating = False
    
'   *** Specify columns to apply this to ***
    myStartCol = "A"
    myEndCol = "K"


'   *** Specify start row ***
    If (Target.Row > 3 And Target.Row < 29) Then
          myStartRow = 4
    Else: myStartRow = 29
    End If
'   Use first column to find the last row
    If (Target.Row > 3 And Target.Row < 29) Then
          myLastRow = 28
    Else: myLastRow = 30
    End If
    
'   Build range to apply this to
    Set myRange = Range(Cells(myStartRow, myStartCol), Cells(myLastRow, myEndCol))
    
'   Clear the color of all the cells in range
    Range("A4:K30").Interior.ColorIndex = 2
    
'   Check to see if cell selected is outside of range
    If Intersect(Target, myRange) Is Nothing Then Exit Sub
    
'   This color will Highlight the row
    If (Target.Row > 3 And Target.Row < 29) Then
    Range(Cells(Target.Row, myStartCol), Cells(Target.Row, myEndCol)).Interior.ColorIndex = 8
'   This color will Highlight the column
    Range(Cells(4, Target.Column), Cells(28, Target.Column)).Interior.ColorIndex = 8
    Else
    Range(Cells(Target.Row, myStartCol), Cells(Target.Row, myEndCol)).Interior.ColorIndex = 3
    End If
'   This color will Highlight the cell in the row
    If (Target.Row > 3 And Target.Row < 29) Then
    Target.Interior.Color = vbGreen
    Else
    Target.Interior.Color = vbRed
    End If
    Application.ScreenUpdating = True


End Sub
Private Sub Worksheet_Change(ByVal Target As Range)


'   Exit if more than one cell updated at a time
    If Target.Count > 1 Then Exit Sub


'   Check to see if value updated is in column B or D
    If Target.Column = 2 Or Target.Column = 4 Then
        Application.EnableEvents = False
        If UCase(Cells(Target.Row, "B")) = "REFUND" Then
            Cells(Target.Row, "D") = Abs(Cells(Target.Row, "D")) * -1
        Else
            If Cells(Target.Row, "B") = "" Then Cells(Target.Row, "D").ClearContents
        End If
        Application.EnableEvents = True
    End If
    If Not (Application.Intersect(Target, Range("A3:K28")) _
      Is Nothing) Then
        With Target
            If Not .HasFormula Then
                Application.EnableEvents = False
                .Value = UCase(.Value)
                Application.EnableEvents = True
            End If
        End With
    End If
End Sub


Private Sub Worksheet_Activate()
Range("A4").Activate
End Sub
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Morning,
Lets try this approach.

How do you write an autosum calculation.
I wish to sum up the values in column A6:A50 & the calculation will be in cell A56

Basically i need to take into account positive & negative figures that are in A6:A50

Thanks
 
Upvote 0
hi ipbr21054,

Re Post#1, What is the formula in K33 as I don't see it being changed by the code and conditional formatting should not change the value.

Re Post#2, in cell A56 the formula =SUM(A6:A50) will take account of +/-.

Hope this helps,

Eric
 
Upvote 0
Hi,
The code in cell K33 is as follows
Code:
=SUM('INCOME (1)'!G32 -'EXPENSES (1)'!K32)-MILEAGE!C32

Ive just looked at this now and ive think ive confused myself but now its as if 2+2 = 5 & i cant see that its wrong if you know what i mean.

Take this for example.
Cell D30 = £100
Cell K32 is the total of various cells =SUM(D30:F30:G30:H30:I30:J30:K30)
Cell K33 is the sum of various cells ('INCOME (1)'!G32 -'EXPENSES (1)'!K32)-MILEAGE!C32

At present cell K32 is £100 and cell K33 is £400

I then apply a refund of £46.99
Cell D30 = £53.01 of which is correct
Cell K32 is K32 is £53.01 of which is correct

BUT cell K33 is £446.99 i see it as my profit should of gone down by £46.99 NOT up by £46.99

Did i explain it ok for you>

Thanks
 
Upvote 0
Hi,

In K33 you are subtracting the value of K32. The value in K32 has fallen therefor the value in K33 increases.

I don't know what is in all the other cells summed by K32, but seems like you may have a mix of charges & refunds?

Edit - But it looks like you are calculating Profit and so if you did get a refund then your Profit should go up?

Hope this helps

Eric
 
Last edited:
Upvote 0
You have hit the nail on the head.
The refund should of been entered on the income sheet not the expenses sheet.
I was sending a refund not receiving one
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top