Tickmark Macro

[ryanhuling]

I would like to have a macro that will sum noncontiguous numbers in a
column, place a numbered tickmark to the right of each number, and a
corresponding tickmark to the left of the cell containing the sum
(which would be located two cells below the last cell with a value in
column B). I would like to be able to select the noncontiguous numbers
and then run the macro. So for instance, if column C contained random
values in rows 1 through 10, and I wanted to sum cells B1, B2, B6, and
B10, I would like to be able to select these cells, then run the
macro, which would place (for example) a "1" in C1, C2, C6, and C10,
and then place the sum in B12 (two cells below the last cell with a
value in column B), and would place a "1" in A12. Additionally, I
would like the macro to be able to track the numbers that it places
next to the cells, and increase it each time, so that after running it
the first time, it would place a "2" next to each cell, etc. I know
that this is not your simple record-and-use macro, which is why I
haven't done it. If anyone out there reading this is an accountant/
auditor, you know that this would be useful for ticking and tying, and
its possible that a macro already exists to do this. If you can give
me a hand with this, it would save myself and a lot of new-hires time
on the job. Possible variations to this macro would include requiring
me to enter the number I would like to place next to the cells, or
requiring me to select the cell where I would like to place the sum.
One of the given assumptions to run this macro would be that the
column to the right of the column containing my targeted values would
be empty.

 

[Guest]

Sub ABC()
Dim rng as Range, num as Long
set rng = Intersect(selection.EntireRow,Columns(2))
num = application.Max(Columns(3)) + 1
for each cell in rng
cell.offset(0,1).Value = num
Next
With cells(rows.count,2).end(xlup).offset(3,0)
.offset(0,1).Value = num
.formula = "=Sum(" & rng.Address & ")"
.Formula = .Value
End with
End Sub

Untested, but try the above.

If you selected a value that had been used in a previous summation, this
would overwrite its tick with a new number. I don't know how you would want
that handled. Also, if run a second time, it places the answer two rows
below the last answer. Is that what you want. (other choices would be to
replace the last answer or to put it in the cell below the last answer - in
either case, this would require no blank cells in the original values or a
smarter algorithm for placement).

 

[ryanhuling]

Wow, I didn't expect a reply so quickly, but yes, that works very
well. As far as the conflict with over-writing the tick from a
previous summation, would it be possible to add the tick to the
previous one, so that it showed, for example, "1,2" This would
probably have to be formatted as a text value. And yes, any
subsequent summations I would like place below the previous, but the
code as it currently is written places it down one cell more than I
would like. I think I can figure out where in the code to change
that, however.

 

[Guest]

Sub ABC()
Dim rng As Range, num As Long
Dim rng1 As Range
Set rng = Intersect(Selection.EntireRow, Columns(2))
num = Application.Max(Columns(3)) + 1
For Each cell In rng
If IsEmpty(cell.Offset(0, 1)) Then
cell.Offset(0, 1).Value = num
Else
cell.Offset(0, 1).Value = cell.Offset( _
0, 1).Value & "," & num
End If
Next
Set rng1 = Cells(1, 2).End(xlDown).Offset(2, 0)
If Not IsEmpty(rng1) Then
If IsEmpty(rng1(2)) Then
Set rng1 = rng1(2)
Else
Set rng1 = rng1.End(xlDown)(2)
End If
End If
With rng1
.Offset(0, 1).Value = num
.Formula = "=Sum(" & rng.Address & ")"
.Formula = .Value
End With
End Sub

 

[ryanhuling]

That works beautifully. I used the first set of code for selecting
the cell in which to place the summation, for some reason the second
code put the summation directly below the cells being summed, with no
cell in between. But this will help tremendously.

Thanks,

Ryan

 

[Guest]

there is no provision in the code for selecting the cell where the summation
is to be placed, so I have no idea what you mean. It puts the sum below the
last value in column B with one blank row in between per your request.
Subsequent sums are placed below the first sum with no blank rows in between
the subsequent sums. As previously stated, it assumes the data begins in B1
and is contiguous below that with no blank cells. my understanding of what
you wanted.

 

[ryanhuling]

The second set of code you sent, was placing the summation directly
below the last value in column B. I wanted it with one cell between
the last value. The first set of code worked fine with placing it
there, except one cell too far down, so I did a little bit of cutting
and pasting to merge the two sets of code.

I did realize one thing, however. This only works assuming the values
are in column B. Is there a way to make this smarter, so that no
matter which column the values are in, it will still place the tick
marks to the right of the cells selected, but place the summation to
below the last value in column B? I would like to be able to use this
on multiple sets of data, where the data I am summing should all be in
one column, but not necessarily in column B.

 

[Guest]

It would be silly for me to try to anticipate what you really want by
writing code and having you grade my paper. Since I have given you an
example that does work within the stated required conditions I listed, you
should be able to adapt it to your needs since you know them much better than
I.

Set rng = Intersect(Selection.EntireRow, Columns(2))
num = Application.Max(Columns(3)) + 1

would become
set rng = selection
num = application.Max(rng(1).offset(0,1).Entirecolumn) + 1

this would start with 1 for each such column.

--
Regards,
Tom Ogilvy


--
Regards,
Tom Ogilvy