I'm learning VBA but have a long way to go and sure would appreciate any help to get me there. I’m using Excel 2010 on Sheet 2, Windows 7 software. Thank-you for any help you can provide.

Mike

I have some VBA coding to do a couple of thing but I could really use some help on adding to it.The first bit is finding any pair of numbers, in cells B30,E30, H30, K30 and N30 only that has a 15 as the last number (eg. 1-15, 12-15, 15-15 etc.) in the set of numbers.

Option ExplicitSub Found(Sheet2)

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet2")

Dim SearchRange As Range, SearchCell, Found As Range

Set SearchRange = ws.Range("B30,E30,H30,H30,K30,N30")For Each SearchCell In SearchRange

Set Found = SearchCell.Find(What:=15, Lookat:=xlPart)

If Not Found Is Nothing ThenI would like to add the following to it:

Only if it finds a 15 two things must happen to the adjacent cell to the right of it:

1- In my Excel sample cell B30 contains the number set 8-15 and the adjacent cell C30 contain the number 15.00.

Conditions:

The 15.00 number will be divided equally by 12 cells (2 decimal places, rounding up). The only issue is the amount to be divided can not exceed the number 12.00 (after 12.00 see below). The amount would be moved to the following cells (added to any existing amount in the cell already, for this example there was no amount in the cells): A36,D36,G36,J36,M36,Q36,A40,D40G40,J40,M40,O40.

The remaining 3.00 would be moved via referencing the first number (of the set) in cell B30 (8 in this example) and search the following 12 cells to find 8:

A35, 1 is located in the cell place the EXCESS number in cell A36 (same for each number below this)

D35, 2 in D36, G35, 3 in G36, J35, 4 in J36, M35, 5 in M36, Q35, 6 in Q36, A39, 7 in A40, D39, 8 in l D40, G39, 9 in G40, J39, 10 in J40, M39, 11 in M40, O39, 12 in O40.The correct cell for 8-15 it in D39. The program would then put the EXCESS amount, 3.00 in this example, in the cell below, D40 (example spreadsheet - new total 1.00 + 3.00 = 4.00).

After this operation there are no contents in cell C30.

The final thing to do is move the 8-15 in cell B30. I need the program to reference the following cells:I have the following code for this but I’m too sure about it:

Sub ShiftAndIncrease()

Dim cell As Range, key As Variant

With CreateObject("Scripting.Dictionary")

For Each cell In Range("D1:D12").SpecialCells(xlCellTypeConstants) '

.Item(cell.Row Mod 12 + 1) = Increase(cell.Value2)

Next

Range("D1:D12").ClearContents

For Each key In .keys

Range("E" & key).Value = "'" & .Item(key)

Next

End With

End Sub

End Function

If 15 is located in cell B30 reference cell B3 for number 1, search cells D1 to D12 to find number 1 and place the set of numbers in the adjacent cell to the right of number by 1. Same with other cells: E30 is no. 2, H30 is no 3, L30 is no. 4 and N30 is no 5.In this example 8-15 would be moved to cell E1.

After this operation there are no contents in cell B30.

That’s it. Thank-you for your help.

Ask Your Question

Weekly Poll