IF, Then Deduct Macro

ktoon

New Member
Joined
Feb 5, 2015
Messages
30
Hi All,

I have an extremely difficult issue that I am trying to solve by using a Macro, but I'm not sure if this is beyond Macro capabilities!

Currently, I have a macro for the below data, if Column B = 1 or 4 then replace data in Column C with Column D - then delete all of column D. This works fine.



ABCD
70912442
70942442
70920142
70991242
71120142
71193642
71213642
71243642
71220142
71291242

<colgroup><col width="64" span="4" style="width:48pt"> </colgroup><tbody>
</tbody>

However, now what I am trying to do brings in an IF statement also based on Column A, in which is a unique ID tied to a person.

So, on a per person basis (ID in column A), after the macro I stated above has run, would deduct the value from column C, where the ID = 9 in Column B FROM the values in Column C where the ID = 1 or 4 in Column B

To use Column A ID 709 as an example, this is how the output should like once complete:

ABC
709130
709430
709201
709912

<tbody>
</tbody>

And in the Example of person 711 above, who has no 1 or 4 ID in Column B associated, no deductions would take place for them (since the deducted ID's are not present for that person) and it would look exactly as it does above so no changes necessary.

Hopefully some genius out there can help me figure this one out I've:confused: been at it hours but it's far too confusing!
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
taking your first row, the macro puts 42 in col c and deletes the 42 in col d

so how do you get 30 in col c
 
Upvote 0
This is the final outcome that I am trying to get to oldbrewer. With my Macro alone, Column C values (for Column B values 1 and 4) would in fact be 42. But what I need the additional Macro to do is then minus the value from Column C for Column B ID 9, which would = 30 in the above case.

If the macro was to run the entire document (it actually has several hundred people) it would look like this:

ABCD
709130
709430
709201
709912
711201
711936
712130
712430
712201
712912

<tbody>
</tbody>

Hope this makes sense.
 
Upvote 0
Try this on a copy of the workbook:

Code:
Sub myMacro()

Dim lrow As Long
Dim mylookup As Long
Dim c As Range

lrow = Range("A" & Rows.Count).End(xlUp).Row

For Each c In Range("A2:A" & lrow)
    mylookup = 0
    If c.Offset(0, 1).Value = 1 Or c.Offset(0, 1).Value = 4 Then
        On Error Resume Next
        mylookup = Evaluate("=INDEX(C2:C" & lrow & ",MATCH(1,IF(A2:A" & lrow & "=" & c.Value & ",IF(B2:B" & lrow & "=9,1)),0))")
        On Error GoTo 0
        c.Offset(0, 2) = c.Offset(0, 3) - mylookup
    End If
Next

Range("D2:D" & lrow).ClearContents

End Sub
 
Upvote 0
Hi Steve,

That didn't appear to work, this is what happened:

What it was:

A B C
709 1 42
709 4 42
709 20 1
709 9 12
711 20 1
711 9 36
712 1 42
712 4 42
712 20 1
712 9 12

This is after running your macro:
A B C
709 1 -12
709 4 -12
709 20 1
709 9 12
711 20 1
711 9 36
712 1 -12
712 4 -12
712 20 1
712 9 12

But this is what it should have been:
A B C
709 1 30
709 4 30
709 20 1
709 9 12
711 20 1
711 9 36
712 1 30
712 4 30
712 20 1
712 9 12
 
Upvote 0
Mine is to convert the data shown in post number 1. Not after you have converted it with your macro first but on the initial data.
 
Upvote 0
ktoon,

Welcome to the MrExcel forum.

1. What version of Excel, and, Windows are you using?

2. Are you using a PC or a Mac?

If I understand you correctly, here is another macro solution for you to consider, based on the raw data structure, and, grouping, you have displayed.

You can change the raw data worksheet name in the macro.

Sample raw data:


Excel 2007
ABCD
170912442
270942442
370920142
470991242
571120142
671193642
771213642
871243642
971220142
1071291242
11
Sheet1


After the macro:


Excel 2007
ABCD
1709130
2709430
3709201
4709912
5711201
6711936
7712130
8712430
9712201
10712912
11
Sheet1


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Code:
Sub ktoon()
' hiker95, 08/12/2015, ME875043
Dim lr As Long, r As Long, rr As Long, n As Long
Application.ScreenUpdating = False
With Sheets("Sheet1")   '<-- you can change the sheet name here
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  For r = 1 To lr
    n = Application.CountIf(.Columns(1), .Cells(r, 1).Value)
    If n > 2 Then
      For rr = r To r + n - 3
        .Cells(rr, 3).Value = .Cells(rr, 4).Value - .Cells(r + n - 1, 3).Value
      Next rr
    End If
    r = r + n - 1
  Next r
  .Range("D1:D" & lr).ClearContents
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the ktoon macro.
 
Upvote 0
I believe I have a working version from what Steve suggested:

I have 2 different versions:

Code:
Sub holidayBA()


Dim lrow As Long
Dim mylookup As Long
Dim c As Range


lrow = Range("A" & Rows.Count).End(xlUp).Row


For Each c In Range("A1:A" & lrow)
    mylookup = 0
    If c.Offset(0, 1).Value = 1 Or c.Offset(0, 1).Value = 4 Or c.Offset(0, 1).Value = 5 Then
        On Error Resume Next
        mylookup = Evaluate("=INDEX(C1:C" & lrow & ",MATCH(1,IF(A1:A" & lrow & "=" & c.Value & ",IF(B1:B" & lrow & "=9,1)),0))")
        On Error GoTo 0
        c.Offset(0, 2) = c.Offset(0, 3) - mylookup
    End If
Next


Range("D1:D" & lrow).ClearContents


End Sub


Sub holidayBK()


Dim lrow As Long
Dim mylookup As Long
Dim c As Range


lrow = Range("A" & Rows.Count).End(xlUp).Row


For Each c In Range("A1:A" & lrow)
    mylookup = 0
    If c.Offset(0, 1).Value = 1 Or c.Offset(0, 1).Value = 5 Then
        On Error Resume Next
        mylookup = Evaluate("=INDEX(C1:C" & lrow & ",MATCH(1,IF(A1:A" & lrow & "=" & c.Value & ",IF(B1:B" & lrow & "=9,1)),0))")
        On Error GoTo 0
        c.Offset(0, 2) = c.Offset(0, 3) - mylookup
    End If
Next


Range("D1:D" & lrow).ClearContents


End Sub

The first Macro is changed if it is 1, 4 or 5 (I made some small change), then the 2nd is essentially unchanged.

The only other thing i changed was everything to ROW 1 since I don't use headers and data is directly dumped to A1.

Thank you for all the help!
 
Upvote 0
Hi Hiker,

No, I must admit I did not try your solution - I couldn't identify in the code where I could manually change the affected ID's. I originally asked for the deduction to only occur for ID's with 1 and 4, but I actually need an alternative that performs the same function except against 1, 4 and 5 (as in the Macro I posted).

Although it appears the Macro I posted works fine (provided by Steve), do you believe that there is a benefit to your code instead of this? (not trying to be insulting/rude if I sound that way at all)
 
Upvote 0

Forum statistics

Threads
1,213,489
Messages
6,113,954
Members
448,535
Latest member
alrossman

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