Colin said:Hi
I need a small macro to find the lowest number in a given column , and
then replace it with a number input through a popup.
Can anyone help?
Grateful for any assistance.
smartin said:Try this:
Sub ReplaceIt()
Dim TheMin As Variant
Dim TheOffset As Long
Dim TheCell As String
Dim TheNewValue As Variant
TheMin = Application.WorksheetFunction. _
Min(Range("A:A"))
TheOffset = Application.WorksheetFunction. _
Match(TheMin, Range("A1:A9999"), 0)
TheCell = Range("A1").Offset(TheOffset - 1).Address
TheNewValue = InputBox("Minimum value found was " & _
TheMin & ". Enter value to replace.")
Range(TheCell).Value = TheNewValue
End Sub
Colin said:Hi
OK thanks very much for helping.
It works fine , but only changes one value , rather than all the
matching ones.
For example , it found the lowest to be 1.95 and I asked it to change
this to 1.25. It did it , but only to the first occurrence of a cell
with 1.95 and left all the others intact. Could it be tweaked to change
all cells with the lowest value?
Also , because the column I need it to work on could vary would it be
possible to enter the column to be selected via a popup and for it to
work on the whole column down to the last row wherever that is?
Grateful again for you advice.
Best Wishes
smartin said:Hi Colin, sorry for the late reply.
Without creating a user form, the approach I would take would be:
- Sub1 with input box to query user for the column, call and pass result to Sub2.
- Sub2 with input box to query user for min value, then leverage Application.Worksh
eetFunction.Rep
lace and the column reference obtained above to do the heavy lifting.
Sorry I don't feel like coding just now, post back if you get stuck!
Colin said:Hi
OK I understand the feeling!
I see the logic in your outline above , but I'm afraid I don't have the
technical skills to code this. Maybe when you have more time available
you could assist. I'd be grateful for that.
Thanks again
Best Wishes
Colin
smartin said:Sub ReplaceIt2()
Dim TheColumn As Variant
Dim TheRange As String
Dim TheMin As Variant
Dim TheNewValue As Variant
Dim OriginalRange As String
Dim OriginalCell As String
On Error GoTo Quitter
Application.ScreenUpdating = False
OriginalRange = Selection.Address
OriginalCell = ActiveCell.Address
TheColumn = InputBox("Which column?")
If TheColumn <> "" Then
TheRange = TheColumn & ":" & TheColumn
TheMin = Application.WorksheetFunction. _
Min(Range(TheRange))
TheNewValue = InputBox("Minimum value found was " & _
TheMin & ". Enter value to replace.")
Range(TheRange).Select
Selection.Replace What:=TheMin, _
Replacement:=TheNewValue, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
Range(OriginalRange).Select
Range(OriginalCell).Activate
Else
MsgBox "No input, quitting."
End If
Quitter:
Application.ScreenUpdating = True
End Sub
Colin said:Hi
OK thanks - this worked perfectly first time and precisely fits the
bill. I'm impressed.
I did find that on the second popup (Minimum value found was ..Enter
value to replace..) that if I click 'cancel' then all of the selected
values from the first popup are wiped form the worksheet , leaving blank
cells. I imagined it would just exit the routine with no further action
or impact.
Anyway , thanks again.
Best Wishes
Colin
smartin said:My bad! That would be the one thing I did not test. Not very good programming, is
it? (^: Try this
replacement:
Sub ReplaceIt2()
Dim TheColumn As Variant
Dim TheRange As String
Dim TheMin As Variant
Dim TheNewValue As Variant
Dim OriginalRange As String
Dim OriginalCell As String
On Error GoTo Quitter
Application.ScreenUpdating = False
OriginalRange = Selection.Address
OriginalCell = ActiveCell.Address
TheColumn = InputBox("Which column?")
If TheColumn <> "" Then
TheRange = TheColumn & ":" & TheColumn
TheMin = Application.WorksheetFunction. _
Min(Range(TheRange))
TheNewValue = InputBox("Minimum value found was " & _
TheMin & ". Enter value to replace.")
If TheNewValue <> "" Then
Range(TheRange).Select
Selection.Replace What:=TheMin, _
Replacement:=TheNewValue, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
Else
MsgBox "No input, operation canceled."
End If
Range(OriginalRange).Select
Range(OriginalCell).Activate
Else
MsgBox "No input, quitting."
End If
Quitter:
Application.ScreenUpdating = True
End Sub
Colin said:HI
BTW Would it be an easy amendment for the routine to operate directly on
the column where the cursor is , rather than ask for an input letter at
the beginning? It would be useful in some circumstances if it just
assumed that the column where the cursor is is the one to be worked on.
That's all , I promise.
Best Wishes
Colin
smartin said:Replace this:
TheColumn = InputBox("Which column?")
With this:
TheColumn = Left(OriginalCell, _
InStr(2, OriginalCell, "$") - 1)
Want to reply to this thread or ask your own question?
You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.