Making code less column-specific

[Colin Hayes]

Hi

My code below uses columns D and then E to allow a number change via a
Popup.

I need to make this more generic if possible , and instead of having
specific columns I'd like it to work on whichever column I select prior
to running the code.

Can anyone help amend the code below to accommodate this?

Grateful for any help. lrow is a variable representing the last cell in
the column.




Columns("D").Select
Selection.Insert Shift:=xlToRight
Range("D2").Select
Dim intNumber As Double
intNumber = InputBox("Vary Number By How Much?", "Variation")
ActiveCell.FormulaR1C1 = "=RC[1]+" & intNumber
Range("D2").Select
Selection.AutoFill Destination:=Range("D2" & lrow),
Type:=xlFillDefault
Range("D2" & lrow).Select
Range("E1").Select
Selection.Cut Destination:=Range("D1")
Range("D1").Select
Selection.Copy
Range("E1").Select
ActiveSheet.Paste
Columns("D").Select
Application.CutCopyMode = False
Selection.Copy
Columns("E:E").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Columns("D").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft

 

[Don Guillett]

I can't figure out what you are doing but try this

Sub fff()
Application.ScreenUpdating = False
Dim intNumber, mc As Double
Dim lrow As Long
mc = 4 '"d"
lrow = Cells(Rows.Count, mc).End(xlUp).Row - 1
Columns(mc).Insert
intNumber = InputBox("Vary Number By How Much?", "Variation")
Cells(2, mc).FormulaR1C1 = "=RC[1]+" & intNumber
Cells(2, mc).AutoFill Destination:=Cells(2, mc).Resize(lrow)
Cells(1, mc + 1).Cut Destination:=Cells(1, mc)
Cells(1, mc).Copy Cells(1, mc + 1)
Columns(mc + 1).Value = Columns(mc).Value
Columns(mc).Delete
Application.ScreenUpdating = True
End Sub

 

[Colin Hayes]

I can't figure out what you are doing but try this

Sub fff()
Application.ScreenUpdating = False
Dim intNumber, mc As Double
Dim lrow As Long
mc = 4 '"d"
lrow = Cells(Rows.Count, mc).End(xlUp).Row - 1
Columns(mc).Insert
intNumber = InputBox("Vary Number By How Much?", "Variation")
Cells(2, mc).FormulaR1C1 = "=RC[1]+" & intNumber
Cells(2, mc).AutoFill Destination:=Cells(2, mc).Resize(lrow)
Cells(1, mc + 1).Cut Destination:=Cells(1, mc)
Cells(1, mc).Copy Cells(1, mc + 1)
Columns(mc + 1).Value = Columns(mc).Value
Columns(mc).Delete
Application.ScreenUpdating = True
End Sub

Hi Don

Thanks for getting back , and for your expertise.

Essentially , I want to select a column and then vary the number in the
cells by that specified in the popup. This would be applied to each cell
with content down to the bottom of the column.

The actual column selected to run the code on might well vary so the
code needs to be non-specific in that respect.

I couldn't get the code above to work , but I'm thinking I wasn't as
clear as I might have been in my post.

Anyway , hopefully the proposition is clearer and I'm grateful any help.



Best Wishes


Colin

 

[Don Guillett]

Show your layout or send a sample workbook to my address below with a clear
explanation and before/after examples.

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)

I can't figure out what you are doing but try this

Sub fff()
Application.ScreenUpdating = False
Dim intNumber, mc As Double
Dim lrow As Long
mc = 4 '"d"
lrow = Cells(Rows.Count, mc).End(xlUp).Row - 1
Columns(mc).Insert
intNumber = InputBox("Vary Number By How Much?", "Variation")
Cells(2, mc).FormulaR1C1 = "=RC[1]+" & intNumber
Cells(2, mc).AutoFill Destination:=Cells(2, mc).Resize(lrow)
Cells(1, mc + 1).Cut Destination:=Cells(1, mc)
Cells(1, mc).Copy Cells(1, mc + 1)
Columns(mc + 1).Value = Columns(mc).Value
Columns(mc).Delete
Application.ScreenUpdating = True
End Sub

Hi Don

Thanks for getting back , and for your expertise.

Essentially , I want to select a column and then vary the number in the
cells by that specified in the popup. This would be applied to each cell
with content down to the bottom of the column.

The actual column selected to run the code on might well vary so the code
needs to be non-specific in that respect.

I couldn't get the code above to work , but I'm thinking I wasn't as clear
as I might have been in my post.

Anyway , hopefully the proposition is clearer and I'm grateful any help.



Best Wishes


Colin

 

[Colin Hayes]

Show your layout or send a sample workbook to my address below with a clear
explanation and before/after examples.

Don ,

Here's an example :

Before

A B C D

1 132 56 12
2 133 56 13
3 134 56 14
4 135 56 15
5 136 56 16
6 137 56 17
7 138 56 18
8 139 56 19
9 140 56 20
10 141 56 21
11 142 56 22
12 143 56 23
13 144 56 24
14 145 56 25
15 146 56 26



* I need to be able to highlight any complete column , and run the
macro.

* The Popup will ask me what number to add or subtract from the cells in
the column I've chosen.

*EG I highlight column B , and run the macro. I enter a figure of -5 and
click OK. Each number in column B is reduced by 5.


* The changes overwrite the original cells , down to the last one in the
column.

* The macro would work on the selected column , whichever it is.

* There is a header cell , so it would operate from Row 2 down.



After

A B C D

1 127 56 12
2 128 56 13
3 129 56 14
4 130 56 15
5 131 56 16
6 132 56 17
7 133 56 18
8 134 56 19
9 135 56 20
10 136 56 21
11 137 56 22
12 138 56 23
13 139 56 24
14 140 56 25
15 141 56 26


* Hope that's a bit clearer now. Outcome shown above.



Best Wishes


Colin

 

[Don Guillett]

This assumes a header row for row 1. If you do not have a header row simply
insert a row.

Sub changeallnumbersinselectedcolumn()
Dim mc, lr As Long
Dim row1value As String
mc = ActiveCell.Column
lr = Cells(Rows.Count, mc).End(xlUp).Row
If lr = 1 Then Exit Sub
row1value = Cells(1, mc)
Cells(1, mc) = InputBox("Vary Number By How Much?")
Cells(1, mc).Copy
Range(Cells(2, mc), Cells(lr, mc)).PasteSpecial _
Paste:=xlPasteAll, Operation:=xlAdd
Application.CutCopyMode = False
Cells(1, mc) = row1value
End Sub

 

[Don Guillett]

If you have blanks or text or "the dreaded space bar" you may like this
better.

Sub changeallnumbersifblanks()
Dim mc, lr, i, mv As Long
mc = ActiveCell.Column
lr = Cells(Rows.Count, mc).End(xlUp).Row
If lr = 1 Then Exit Sub
mv = InputBox("Vary Number By How Much?")
For i = 2 To lr
If IsNumeric(Cells(i, mc)) And _
Len(Application.Trim(Cells(i, mc))) > 0 Then
Cells(i, mc).Value = Cells(i, mc).Value + mv
End If
Next i
End Sub

 

[Colin Hayes]

This assumes a header row for row 1. If you do not have a header row simply
insert a row.

Sub changeallnumbersinselectedcolumn()
Dim mc, lr As Long
Dim row1value As String
mc = ActiveCell.Column
lr = Cells(Rows.Count, mc).End(xlUp).Row
If lr = 1 Then Exit Sub
row1value = Cells(1, mc)
Cells(1, mc) = InputBox("Vary Number By How Much?")
Cells(1, mc).Copy
Range(Cells(2, mc), Cells(lr, mc)).PasteSpecial _
Paste:=xlPasteAll, Operation:=xlAdd
Application.CutCopyMode = False
Cells(1, mc) = row1value
End Sub

HI Don

OK Thanks for your expertise on this - it worked perfectly first time.

Excellent - it fits the bill in every way.


BTW Just out of interest , I see that the popup allows addition and
subtraction but not division or multiplication.

Is it an easy extension to make to allow it to accept all four
mathematical processes?



Best Wishes


Colin

 

[Don Guillett]

Please post at the TOP when responding to me. Most prefer that way.
I just recorded this to show you how the recorder can be your friend.
Easy enough to put in an input box asking for the desired function.

Sub Macro5()
'
' Macro5 Macro
' Macro recorded 1/24/2009 by Donald B. Guillett
'

'
Range("B7").Select
Selection.Copy
Range("G3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False
Range("G4").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlDivide,
SkipBlanks _
:=False, Transpose:=False
Range("G5").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlSubtract, _
SkipBlanks:=False, Transpose:=False
Range("G6").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:=
_
False, Transpose:=False
End Sub

 

[Colin Hayes]

HI Don

OK Thanks for that.

I do use the recorder sometimes , but it always makes code column or
cell-specific. This is the case also in your example below. It was
specifically to avoid this that I posted my query.

I was just wondering if the code you sent before could be modified to
accommodate Multiplication and Division , and then be applied to the
highlighted column , whichever it may be.

Anyway , very grateful for your expert help. Much appreciated.



Best Wishes


Colin

 

[Don Guillett]

And I was using it to show you the choices. Incorporated here with a choice.

Sub changeallnumbersChooseOperation()
Dim mc, lr As Long
Dim row1value, dowhat, x As String
mc = ActiveCell.Column
lr = Cells(Rows.Count, mc).End(xlUp).Row
If lr = 1 Then Exit Sub
row1value = Cells(1, mc)
Cells(1, mc) = InputBox("Vary Number By How Much?")
dowhat = InputBox("A to add, D to divide, M to multiply, S to subtract")
Select Case UCase(dowhat)
Case "A": x = xlAdd
Case "D": x = xlDivide
Case "M": x = xlMultiply
Case "S": x = xlSubtract
Case Else
MsgBox "Not a choice"
Exit Sub
End Select
Cells(1, mc).Copy
Range(Cells(2, mc), Cells(lr, mc)).PasteSpecial _
Paste:=xlPasteAll, Operation:=x
Application.CutCopyMode = False
Cells(1, mc) = row1value
End Sub

 

[Colin Hayes]

Hi Don

Yes , I see. This work perfectly and is a very useful application.

Thanks again for your considerable help.



Best Wishes


Colin