Combining 2 Macros

johngio

Board Regular
Joined
Jan 28, 2005
Messages
174
Hi all,

I have created 2 Macros; 1 looks for a value that is increasing and continues to add to it.

The other checks these numbers, and if the number has exceeded 100000 it will lock this number and start increasing the smallest column.

The macros are:


Sub test()
Dim iRow As Integer, iCol As Integer
For iCol = 7 To 9
For iRow = 16 To 279


If Cells(iRow, iCol) = "" Then

If Cells(iRow - 2, iCol) = Cells(iRow - 1, iCol) Or Cells(iRow - 2, iCol) = 0 Then
Cells(iRow, iCol) = Cells(iRow - 1, iCol)
Else
Cells(iRow, iCol) = Cells(iRow - 1, iCol) + Range("Q15")
End If

End If
Next iRow
Next iCol
End Sub

and


Sub Goo()
For iCol = 7 To 9
For iRow = 16 To 279

If Cells(iRow, iCol).Value > 100000 Then
Cells(iRow + 1, iCol) = Cells(iRow, iCol)

If Cells(iRow, 7) < Cells(iRow, 8) And Cells(iRow, 7) < Cells(iRow, 9) Then
Cells(iRow, 7) = Cells(iRow - 1, 7) + Range("Q15")
ElseIf Cells(iRow, 9) < Cells(iRow, 8) And Cells(iRow, 9) < Cells(iRow, 7) Then
Cells(iRow, 9) = Cells(iRow - 1, 9) + Range("Q15")
ElseIf Cells(iRow, 8) < Cells(iRow, 7) And Cells(iRow, 8) < Cells(iRow, 9) Then
Cells(iRow, 8) = Cells(iRow - 1, 8) + Range("Q15")
End If
End If
Next iRow
Next iCol
End Sub

What I would like to do is combine these two, such that everytime a new row is reachedthe macro checks if the value is greater than 100000. If it is, this value is "locked" and Q15 is added to the next smallest column.

I'm having a little trouble combining these two.

The output should resemble this:


71642 19174 18888
71642 19174 18888
71642 19174 18888
71642 19174 18888
71642 19174 18888
71642 19174 18888
71642 19174 18888
71642 19174 18888
71642 19174 18888
71642 19174 18888
71642 19174 18888
71642 19174 18888
71642 19174 18888
71642 20974 18888
71642 22774 18888
71642 24574 18888
71642 26374 18888
71642 28174 18888
71642 29974 18888
71642 31774 18888
71642 33574 18888
71642 35374 18888
71642 37174 18888
71642 38974 18888
71642 40774 18888
71642 42574 18888
71642 44374 18888
71642 46174 18888
71642 47974 18888
71642 49774 18888
71642 51574 18888
71642 53374 18888
71642 55174 18888
71642 56974 18888
71642 58774 18888
71642 60574 18888
71642 62374 18888
71642 64174 18888
71642 65974 18888
71642 67774 18888
71642 69574 18888
71642 71374 18888
71642 73174 18888
71642 74974 18888
71642 76774 18888
71642 78574 18888
71642 80374 18888
71642 82174 18888
71642 83974 18888
71642 85774 18888
71642 87574 18888
71642 89374 18888
71642 91174 18888
71642 92974 18888
71642 94774 18888
71642 96574 18888
71642 98374 18888
71642 100174 20688
71642 100174 22488
71642 100174 24288
71642 100174 26088
71642 100174 27888
71642 100174 29688
71642 100174 31488
71642 100174 33288
71642 100174 35088
71642 100174 36888
71642 100174 38688
71642 100174 40488
71642 100174 42288
71642 100174 44088
71642 100174 45888
71642 100174 47688
71642 100174 49488
71642 100174 51288
71642 100174 53088
71642 100174 54888
71642 100174 56688
71642 100174 58488
71642 100174 60288
71642 100174 62088
71642 100174 63888
71642 100174 65688
71642 100174 67488
71642 100174 69288
71642 100174 71088
71642 100174 72888
71642 100174 74688
71642 100174 76488
71642 100174 78288
71642 100174 80088
71642 100174 81888
71642 100174 83688
71642 100174 85488
71642 100174 87288
71642 100174 89088
71642 100174 90888
71642 100174 92688
71642 100174 94488
71642 100174 96288
71642 100174 98088
71642 100174 99888
73442 100174 101688
75242 100174 101688
77042 100174 101688
78842 100174 101688
80642 100174 101688
82442 100174 101688
84242 100174 101688
86042 100174 101688
87842 100174 101688
89642 100174 101688
91442 100174 101688
93242 100174 101688
95042 100174 101688
96842 100174 101688

Can anyone assist in combining these 2 macros?

Cheers

John
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
Here is my latest effort (which has hit a snag as the value after the first 100000 goes to zero:

Sub test()
Dim iRow As Integer, iCol As Integer
For iCol = 7 To 9
For iRow = 16 To 279


If Cells(iRow, iCol) = "" And Cells(iRow - 1, iCol).Value < 100000 Then

If Cells(iRow - 2, iCol) = Cells(iRow - 1, iCol) Or Cells(iRow - 2, iCol) = 0 Then
Cells(iRow, iCol) = Cells(iRow - 1, iCol)
Else: Cells(iRow, iCol) = Cells(iRow - 1, iCol) + Range("Q15")
End If
ElseIf Cells(iRow, iCol) <> "" And Cells(iRow - 1, iCol).Value < 100000 Then
If Cells(iRow - 2, iCol) - Cells(iRow - 1, iCol) <> Range("Q15") Then
Cells(iRow, iCol) = Cells(iRow, iCol)
Else: Cells(iRow, iCol) = Cells(iRow - 1, iCol) + Range("Q15")
End If

ElseIf Cells(iRow, iCol).Value > 100000 Then

If Cells(iRow, 7) < Cells(iRow, 8) And Cells(iRow, 7) < Cells(iRow, 9) Then
Cells(iRow, 7) = Cells(iRow - 1, 7) + Range("Q15") And Cells(iRow, iCol) = Cells(iRow - 1, iCol)
ElseIf Cells(iRow, 9) < Cells(iRow, 8) And Cells(iRow, 9) < Cells(iRow, 7) Then
Cells(iRow, 9) = Cells(iRow - 1, 9) + Range("Q15") And Cells(iRow, iCol) = Cells(iRow - 1, iCol)
ElseIf Cells(iRow, 8) < Cells(iRow, 7) And Cells(iRow, 8) < Cells(iRow, 9) Then
Cells(iRow, 8) = Cells(iRow - 1, 8) + Range("Q15") And Cells(iRow, iCol) = Cells(iRow - 1, iCol)

End If
End If
Next iRow
Next iCol
End Sub
 
Upvote 0
JFIS this is the result this formula results in:

71642 19174 18888
71642 19174 18888
71642 19174 18888
71642 19174 18888
71642 19174 18888
71642 19174 18888
71642 19174 18888
71642 19174 18888
71642 19174 18888
71642 19174 18888
71642 19174 18888
71642 19174 18888
71642 19174 18888
71642 20974 18888
71642 22774 18888
71642 24574 18888
71642 26374 18888
71642 28174 18888
71642 29974 18888
71642 31774 18888
71642 33574 18888
71642 35374 18888
71642 37174 18888
71642 38974 18888
71642 40774 18888
71642 42574 18888
71642 44374 18888
71642 46174 18888
71642 47974 18888
71642 49774 18888
71642 51574 18888
71642 53374 18888
71642 55174 18888
71642 56974 18888
71642 58774 18888
71642 60574 18888
71642 62374 18888
71642 64174 18888
71642 65974 18888
71642 67774 18888
71642 69574 18888
71642 71374 18888
71642 73174 18888
71642 74974 18888
71642 76774 18888
71642 78574 18888
71642 80374 18888
71642 82174 18888
71642 83974 18888
71642 85774 18888
71642 87574 18888
71642 89374 18888
71642 91174 18888
71642 92974 18888
71642 94774 18888
71642 96574 18888
71642 98374 18888
71642 100174 18888
71642 18888
71642 1800 18888
71642 1800 18888
71642 1800 18888
71642 1800 18888
 
Upvote 0

Forum statistics

Threads
1,214,388
Messages
6,119,229
Members
448,879
Latest member
VanGirl

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