Excel-VBA: Inputting range in userform call - vba

I have growing data files and in a certain column is not fill out. I have the code to fill the data, though I want to make a button to call userform for user to fill in the range so that the code works within the range provided by the user(since data is adjusted by the user itself). The code to fill the blank cell is;
Sub fillblank()
Dim range As Range
Dim cell As Range
Dim value As String
Set range = Sheets("Sheet1").Range("E4:E15")
For Each cell In range
If Trim(cell.Value) <> "" Then
value = cell.Value
Else
cell.Value = value
End if
Next cell
End Sub
I would like the user to enter the range (E4:E15) in userform. How to do the userform if its dependent only range? Thanks stackoverflow.com.

Put a text box in userform and name it txtRng. Then declare a variable named MyRng as String. Assign that text box value to MyRng variable and use this variable as argument of range like...
Set range = Sheets("Sheet1").Range(MyRng)
So, full code will be like as below
Sub fillblank()
Dim range As range
Dim cell As range
Dim value As String
Dim MyRng As String
MyRng = UserForm1.txtRng 'Use your form name here
Set range = Sheets("Sheet1").range(MyRng)
For Each cell In range
If Trim(cell.value) <> "" Then
value = cell.value
Else
cell.value = value
End If
Next cell
End Sub
I also suggest you to not use range, value as variable because some of these reserve keyword. It may cause misbehave of output.

You could use the InputBox() method and have the user select a range:
Sub fillblank()
Dim myRange As Range
Dim cell As Range
Dim myValue As String
Set myRange = Application.InputBox( prompt:="Select a range", Type:=8)
For Each cell In myRange
If Trim(cell.Value) <> "" Then
myValue = cell.Value
Else
cell.Value = myValue
End if
Next
End Sub
or you could add a RefEdit control to your userform and process it
Sub fillblank()
Dim cell As range
Dim myValue As String
For Each cell In range(Me.RefEdit1.Text)
If Trim(cell.value) <> "" Then
myValue = cell.value
Else
cell.value = myValue
End If
Next cell
End Sub
In this case, since the user could input an invalid range, you may want to add a validation function (named GetRange in my following example)
Sub fillblank()
Dim myRange As range
If Not GetRange(Me.RefEdit1.Text, myRange) Then
MsgBox "Select a valid range "
Me.RefEdit1.SetFocus
Exit Sub
End If
Dim cell As range
Dim myValue As String
For Each cell In myRange
If Trim(cell.value) <> "" Then
myValue = cell.value
Else
cell.value = myValue
End If
Next cell
End Sub
Function GetRange(RefEditText As String, myRange As range) As Boolean
On Error Resume Next
Set myRange = range(RefEditText)
On Error GoTo 0
GetRange = Not myRange Is Nothing
End Function
finally, here is an alternative method (no loops) to fill blank cells as you're wanting to do:
Sub fillblank()
With range(Me.RefEdit1.Text).SpecialCells(xlCellTypeBlanks)
.FormulaR1C1 = "=R[-1]C"
.value = .value
End With
End Sub

To ask the user for a range you could use InputBox(Type:=8)
The code bellow will accept only one column
If an entire column is selected (A:A) or multiple columns it adjusts to the total rows in UsedRange and first column in selection
Option Explicit
Public Sub FillBlanks()
Dim selectedCol As Range, itm As Range, lr As Long
On Error Resume Next
Set selectedCol = Application.InputBox(Prompt:="Select column:", Type:=8)
On Error GoTo 0
If selectedCol Is Nothing Then Exit Sub 'User cancelled selection
With selectedCol
.Parent.Activate
lr = .Parent.UsedRange.Rows.Count
If .Columns.Count > 1 Then Set selectedCol = .Resize(.Rows.Count, 1)
If .Rows.Count < 2 Or .Rows.Count > lr Then Set selectedCol = .Resize(lr - .Row + 1, 1)
selectedCol.Select
End With
For Each itm In selectedCol
If Len(Trim$(itm)) = 0 And itm.Row > 1 Then itm.Value2 = itm.Offset(-1).Value2
Next
End Sub
Note: It's not recommended to name your variables with special VBA keywords
Dim range As Range - Range is the most important object in Excel
Dim value As String - Value is the most important property of the Range object

Related

Googled "Can a VBA function in Excel return the cell ids of a range?"

I believe I'm looking for the inverse of the Range Function. I have a named range in my worksheet and in an event macro. I'm interested in getting the range definition string back, such as "A1:A12".
Here is the code I'm working on:
Private Sub UserForm_Initialize()
Dim MyData As Range
Dim r As Long
With Me.ListBox1
.RowSource = ""
Set MyData = Worksheets("Sheet1").Range("A2:D100") 'Adjust the range accordingly
.List = MyData.Cells.Value
For r = .ListCount - 1 To 0 Step -1
If .List(r, 3) = "" Then
.RemoveItem r
End If
Next r
End With
End Sub
I'd rather use the name of the Range in the "Set MyData =" statement above instead of hard-coding the range in the event macro.
If you simply want the address of a Range, use
Dim MyRange as Range
Set MyRange = Worksheets("Sheet1").Range("A2:D100")
' Here do what you want
Msgbox MyRange.Address
.Address will return the "A2:D100" address
https://msdn.microsoft.com/fr-fr/library/office/ff837625.aspx

Prompt to replace empty cells with user-defined text

I need VBA code to check for blank cells within a range. If there are any blanks within that range, a box should come up to allow you to type in what you want to replace the blanks with. The code below does what I want, but the prompt ALWAYS appears, even if there aren't any blanks. How do I make it so the box only appears if there are blanks?
Sub ReplaceBlanks()
Dim Lastrow As Integer
Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Range("D84:D" & Lastrow).Select
Dim cell As Range
Dim InputValue As String
On Error Resume Next
InputValue = InputBox("Enter value that will fill empty cells in selection", "Fill Empty Cells")
For Each cell In Selection
If IsEmpty(cell) Then
cell.Value = InputValue
End If
Next
End Sub
Sub ReplaceBlanks()
Dim Lastrow As Integer
Dim srchRng As Range
Lastrow = Cells(Rows.Count, 1).End(xlUp).Row
Set srchRng = Range(Cells(84, 4), Cells(Lastrow, 4))
Dim InputValue As String
If srchRng.Count - WorksheetFunction.CountA(srchRng) > 0 Then
InputValue = InputBox("Enter value that will fill empty cells in selection", _
"Fill Empty Cells")
srchRng.SpecialCells(xlCellTypeBlanks).Value = InputValue
End If
End Sub
This also adds in the range variable, so you avoid using .Select. It also assumes that you only want ONE inputvalue. If you want it to trigger for each empty cell, put the inputValue = ... in the If IsEmpty(cell) loop.
An alternative to your If a cell is empty loop, is a one line fix:
Range(Cells(84,4),Cells(lastRow,4)).SpecialCells(xlCellTypeBlanks).Value = InputValue. That will take ALL blanks in D84:DlastRow and fill in with whatever the InputValue is. No need to loop.
Sub ReplaceBlanks()
Dim Lastrow As Integer
Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Range("D84:D" & Lastrow).Select
Dim cell As Range
Dim InputValue As String
On Error Resume Next
For Each cell In Selection
If IsEmpty(cell) Then
InputValue = InputBox("Enter value that will fill empty cells in selection", _
"Fill Empty Cells")
cell.Value = InputValue
End If
Next
End Sub
just move the line to the right place :D
YourRange.Cells.Count - WorksheetFunction.CountA(YourRange) will give you the count of blanks so you can check if you have blanks:
Sub ReplaceBlanks()
Dim Lastrow As Integer
Lastrow = ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row 'Use 4 as it is the D column you are working with
Dim cel As Range 'Use cel as CELL can be confused with functions
Dim InputValue As String
If Range("D84:D" & Lastrow).Cells.Count - WorksheetFunction.CountA(Range("D84:D" & Lastrow)) > 0 Then
InputValue = InputBox("Enter value that will fill empty cells in selection", "Fill Empty Cells")
For Each cel In Range("D84:D" & Lastrow)
If IsEmpty(cel) Then
cel.Value = InputValue
End If
Next
End If
End Sub

How to check for data in TextBox

I have a worksheet named "Input" with a Button (ActiveX) and a TextBox (ActiveX). I used VBA to check value of the TextBox when a user clicks the button, but the code cant find the textbox.
My code for the button:
Sub Toevoegen()
Dim invoerenws As Worksheet
Dim overzichtws As Worksheet
Dim nextRow As Long
Dim oCol As Long
Dim myRng As Range
Dim myCopy As String
Dim myCell As Range
'cells to copy from Input sheet - some contain formulas
myCopy = "TextBox1"
Set invoerenws = Worksheets("invoeren")
Set overzichtws = Worksheets("overzicht")
With overzichtws
nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
End With
With invoerenws
Set myRng = .Range(myCopy)
If Application.CountA(myRng) <> myRng.Cells.Count Then
MsgBox "Please fill in all the cells!"
Exit Sub
End If
End With
With overzichtws
With .Cells(nextRow, "A")
.Value = Now
.NumberFormat = "mm/dd/yyyy hh:mm:ss"
End With
.Cells(nextRow, "B").Value = Application.UserName
oCol = 3
For Each myCell In myRng.Cells
overzichtws.Cells(nextRow, oCol).Value = myCell.Value
oCol = oCol + 1
Next myCell
End With
'clear input cells that contain constants
With invoerenws
On Error Resume Next
With .Range(myCopy).Cells.SpecialCells(xlCellTypeConstants)
.ClearContents
Application.GoTo .Cells(1) ', Scroll:=True
End With
On Error GoTo 0
End With
End Sub
If the values are still inside the textBox then you have to reference the object or the control. you can do it like this:
textBox.value = worksheet.cells(1,1)
What this will do is display the value of textBox form control to cell A1. I know this is not what you are looking for but this is the simplest way of showing you how to reference userform objects or controls. You can find the name of a textBox control on a window like this:
You need to use the (Name) when referencing textboxes

show range in message box VBA

I have a function that selects a range based on a whole bunch of criteria from Sheet2. I'm trying to copy this range and to show/paste on Sheet1 or have it show in a message box.
Public Function findrulepos(target As Range, destination As Range) As String
Dim ruleStart As Range
Dim ruleEnd, ruleEnd2 As String
Dim Xcell, PasteRangeIndexCell As Range
Dim RuleRange As Range
Dim LastCell As Range
Dim FirstCell, IndexCell As Range
Dim WholeRule As Range
MaxRule = 100000
MaxRow = 100000
Sheets("ResRules").Select
For i = 2 To MaxRow
If CStr(ThisWorkbook.Sheets("ResRules").Range("A" & i).Value) = CStr(target.Value) Then
Set ruleStart = ThisWorkbook.Sheets("ResRules").Range("B" & i) '.offset(0, 1)
Exit For
End If
Next i
'MsgBox (ruleStart.address)
Set FirstCell = ruleStart.offset(1, -1)
Set IndexCell = FirstCell
Do Until IndexCell.Value <> "" Or IndexCell.Row >= MaxRow
Set IndexCell = IndexCell.offset(1, 0)
Loop
If IndexCell.Value <> "" Then
Set LastCell = IndexCell.offset(-1, 1)
MsgBox (LastCell.Value)
Else
Set LastCell = Nothing
End If
Set WholeRule = ThisWorkbook.Sheets("ResRules").Range("" & ruleStart.address & ":" & LastCell.address & "")
End Function
This is the whole code to give me the range I require
I have added a watch and can see I am getting the correct range i.e. $B$3:$B$6 but cant copy this range to Sheet 1
If your function is being called from a worksheet cell, then copy/paste won't work since that type of function can only return a value to the cell in which it resides. You need a function called from a Sub.
Use the following to get the address:
Sheet1.Range("A1").value = WholeRule.address
or, if you want to copy the actual content in the cells:
WholeRule.copy Sheet1.Range("A1")
thanks guys
worked it out
changed it to a Sub then
Public Sub ReturnRuleButton()
Call findrulepos(ThisWorkbook.Sheets("Main").Cells(2, 5), ThisWorkbook.Sheets("Main").Cells(2, 6))
End Sub

Merge the contents of 2 cells into another 3rd cell using VBA in Excel

I have two cells lets say: A1 and A2
The content of each one of them is a string:
A1: Hallo
A2: World
My goal is to merge the contents of A1 and A2 in another cell e.g. A3 i.e. A3's content should be:
Hallo World
I would like to do this using a VBA macro and not only for strings as contents..
Thanks both of u for your answers!!
Although, as MasterMix says, this is most easily achieved by a formula, if you have a reason why VBA must be used then it depends on how you wish to specify the cells.
You could do this as a function:
Private Function addTwoCells(rngA As Range, rngB As Range) As String
addTwoCells = rngA & rngB
End Function
All this does is replicate the (much faster) built-in Excel concatenate function though.
You could also do it in one of about a hundred ways in a procedure, here's one way that prompts the user for the ranges:
Private Sub addTwoCellsProc()
Dim rngA As String
Dim rngB As String
Dim rngOutput As String
Dim rngTest As Range
Do
rngA = InputBox("Please enter first cell address", "Cell A")
rngA = Range(rngA).Cells(1, 1).Address
Set rngTest = Intersect(Range(rngA).Cells(1, 1), ActiveSheet.Cells)
Loop Until Not rngTest Is Nothing
Do
rngB = InputBox("Please enter second cell address", "Cell B")
rngB = Range(rngB).Cells(1, 1).Address
Set rngTest = Intersect(Range(rngB), ActiveSheet.Cells)
Loop Until Not rngTest Is Nothing
Do
rngOutput = InputBox("Please enter destination cell address", "Output cell")
Set rngTest = Intersect(Range(rngOutput), ActiveSheet.Cells)
Loop Until Not rngTest Is Nothing
Range(rngOutput) = Range(rngA) & Range(rngB)
End Sub
You could also use predefined ranges and loop through them if you have multiple ranges to combine. If you explain a bit more about the scenario then someone might provide more specific code.
I suggest either an Excel formula
=A1&A2
or a VBA macro
Range("A3").Cell.Value = Range("A1").Cell.Value & Range("A2").Cell.Value
This one is quicker, just select the cells and they are merged into the first cell.
'------------------------------------------------------------------------
' Procedure : Concatenate Text
' Author : Tim Bennett
' Date : 11/6/2015
' Purpose : Concatenate selected text into first column
'------------------------------------------------------------------------
'
'Sub Concatenate_Formula(bConcat As Boolean, bOptions As Boolean)
Sub Concatenate()
Dim rSelected As Range
Dim c As Range
Dim sArgs As String
Dim bCol As Boolean
Dim bRow As Boolean
'Set variables
Set rOutput = ActiveCell
bCol = False
bRow = False
On Error Resume Next
'Use current selection
Set rSelected = Selection
On Error GoTo 0
'Only run if cells were selected and cancel button was not pressed
If Not rSelected Is Nothing Then
sArgs = "" 'Create string of cell values
firstcell = ""
For Each c In rSelected.Cells
If firstcell = "" Then firstcell = c.Address(bRow, bCol)
sArgs = sArgs + c.Text + " " 'build string from cell text values
c.Value = "" ' Clear out the cells taken from
Next
'Put the result in the first cell
Range(firstcell).Value = sArgs
End If
End Sub
In a more general case, here's a macro which concatenates any number of cells (even non-adjacent blocks of cells) Note: I didn't include code which checks user's cancellation.
Sub G()
Dim strFinal$
Dim cell As Range
Dim rngSource As Range
Dim rngArea As Range
Dim rngTarget As Range
Set rngSource = Application.InputBox("Select cells to merge", Type:=8)
Set rngTarget = Application.InputBox("Select destination cell", Type:=8)
For Each rngArea In rngSource
For Each cell In rngArea
strFinal = strFinal & cell.Value & " "
Next
Next
strFinal = Left$(strFinal, Len(strFinal) - 1)
rngTarget.Value = strFinal
End Sub