I'm setting up a button to check a range for a value if the value don't exist then copy value to next available row
Private Sub CommandButton2_Click()
Dim LrowCompleted As String
If TextBox1.Text = "" Then
MsgBox "DON'T DO THAT"
Else
LrowCompleted = Sheets("Budget").range("N4").End(xlDown).Row
Sheets("Budget").range("N" & LrowCompleted + 1) = TextBox1.Text
Unload Me
MechanicalEquipment.Show
End If
End Sub
First. LrowCompleted should be a Long not a String.
Second. You need to build the Find portion. Are you only going to find this value in a single column? Example below. Not tested but it should work.
Private Sub CommandButton2_Click()
Dim LrowCompleted As Long, fText as String, Dim findValue As Range
fText = TextBox1.Text
'You probably dont need to check all 3 below but I'm not on excel to check the best one to use.
If fText = "" Or fText = Nothing Or fText = Null Then
MsgBox "Provide what to look for"
Else
Set findValue = Sheets("Budget").Columns("N:N").Find(fText, Range("N1"), xlValues, xlPart, xlByColumns, xlNext)
If findValue Is Nothing Then
'Nothing found lets place it at the end
LrowCompleted = Sheets("Budget").Range("N4").End(xlUp).Row + 1
Sheets("Budget").Range("N" & LrowCompleted) = fText
Unload Me
MechanicalEquipment.Show
Else
'I found something, do nothing i guess
End If
End If
End Sub
Related
Have a column H with alphanumeric characters. Some cells in this column have the content (RAM) followed by 5 digits starting from 00000 to 99999.
If cell H219 has the content (RAM) 23596 then i have to fill cell A219 with a comment "completed".
This has to be done for all cells with the content "(RAM) followed by 5 digits"
Sub Macro16_B()
' ' Macro16_B Macro ' '
intRowCount = Worksheets("Reconciliation").UsedRange.Rows.Count
For i = 11 To intRowCount
If InStr(Range("H" & i).Value, "(RAM 00000-99999") Then
Range("A" & i).Value = "Completed"
End If
Next i
End Sub
A non-VBA answer could be (if the cell doesn't have extra text other than (RAM) & 5 numbers):
=IFERROR(IF(LEN(VALUE(TRIM(SUBSTITUTE(H1,"(RAM)",""))))=5,"completed",""),"")
My VBA answer would be:
Sub Test()
Dim rLastCell As Range
Dim rCell As Range
With Worksheets("Reconciliation")
Set rLastCell = .Columns(8).Find("*", , , , xlByColumns, xlPrevious)
If Not rLastCell Is Nothing Then
For Each rCell In .Range(.Cells(1, 8), rLastCell)
If rCell Like "*(RAM) #####*" Then
rCell.Offset(, -7) = "complete"
End If
Next rCell
End If
End With
End Sub
Cheers #Excelosaurus for heads up on the * would've forgotten it as well. :)
One way is to use the Like operator. The precise format of your string is not clear so you may have to amend (and assuming case insensitive). # represents a single number; the * represents zero or more characters.
Sub Macro16_B()
Dim intRowCount As Long, i As Long
' ' Macro16_B Macro ' '
intRowCount = Worksheets("Reconciliation").UsedRange.Rows.Count
For i = 11 To intRowCount
If Range("H" & i).Value Like "(RAM) #####*" Then
Range("A" & i).Value = "Completed"
End If
Next i
End Sub
Well, there are already 2 good answers, but allow me to paste my code here for good measure, the goal being to submerge #user2574 with code that can be re-used in his/her next endeavors:
Sub Macro16_B()
'In the search spec below, * stands for anything, and # for a digit.
'Remove the * characters if you expect the content to be limited to "(RAM #####)" only.
Const SEARCH_SPEC As String = "*(RAM #####)*"
Dim bScreenUpdating As Boolean
Dim bEnableEvents As Boolean
'Keep track of some settings.
bScreenUpdating = Application.ScreenUpdating
bEnableEvents = Application.EnableEvents
On Error GoTo errHandler
'Prevent Excel from updating the screen in real-time,
'and disable events to prevent unwanted side effects.
Application.ScreenUpdating = False
Application.EnableEvents = False
'Down with business...
Dim scanRange As Excel.Range
Dim cell As Excel.Range
Dim content As String
Dim ramOffset As Long
With ThisWorkbook.Worksheets("Reconciliation").Columns("H")
Set scanRange = .Worksheet.Range(.Cells(11), .Cells(.Cells.Count).End(xlUp))
End With
For Each cell In scanRange
content = CStr(cell.Value2)
If content Like SEARCH_SPEC Then
cell.EntireRow.Columns("A").Value = "Completed"
End If
Next
Recover:
On Error Resume Next
'Restore the settings as they were upon entering this sub.
Application.ScreenUpdating = bScreenUpdating
Application.EnableEvents = bEnableEvents
Exit Sub
errHandler:
MsgBox Err.Description, vbExclamation + vbOKOnly, "Error"
Resume Recover
End Sub
I have a VBA function in Excel returns a concatenated string of text from cells selected by users.
This works as I require, however if there are hidden cells in the selection, the value of the hidden cell is included, which is undesirable. An example of when this issue occurs is when a table is filtered.
Is there a way to amend my function to check if the cell that is being read is visible?
Sub ConcatEmialAddresses()
Dim EmailAddresses As String
ActiveSheet.Range("C3").Value = combineSelected()
ActiveSheet.Range("C3").Select
Call MsgBox("The email address string from cell ""C3"" has been copied to your clipboard.", vbOKOnly, "Sit back, relax, it's all been taken care of...")
End Sub
Function combineSelected(Optional ByVal separator As String = "; ", _
Optional ByVal copyText As Boolean = True) As String
Dim cellValue As Range
Dim outputText As String
For Each cellValue In Selection
outputText = outputText & cellValue & separator
Next cellValue
If Right(outputText, 2) = separator Then outputText = Left(outputText, Len(outputText) - 2)
combineSelected = outputText
End Function
To determine if a Range has an hidden cell, I would check that the height/width of each row/column is different from zero:
Function HasHiddenCell(source As Range) As Boolean
Dim rg As Range
'check the columns
If VBA.IsNull(source.ColumnWidth) Then
For Each rg In source.Columns
If rg.ColumnWidth = 0 Then
HasHiddenCell = True
Exit Function
End If
Next
End If
' check the rows
If VBA.IsNull(source.RowHeight) Then
For Each rg In source.rows
If rg.RowHeight = 0 Then
HasHiddenCell = True
Exit Function
End If
Next
End If
End Function
Sub UsageExample()
If HasHiddenCell(selection) Then
Debug.Print "A cell is hidden"
Else
Debug.Print "all cells are visible"
End If
End Sub
I used this
Function areCellsHidden(Target As Range)
areCellsHidden = False
If (Target.Rows.Hidden = True) Then
areCellsHidden = True
ElseIf (Target.Columns.Hidden = True) Then
areCellsHidden = True
ElseIf (Target.Count > 1) Then
If _
Target.Count <> Target.Columns.SpecialCells(xlCellTypeVisible).Count _
Or Target.Count <> Target.Rows.SpecialCells(xlCellTypeVisible).Count _
Then
areCellsHidden = True
End If
End If
End Function
new to VBA here. I've been stuck on this problem for a while now:
Essentially, I need to create a macro that copies over specific data from one sheet to another, that is up to the user to specify. The catch is that while all the data is in one column (B), not all rows of the column have relevant entries; some are blank and some have other data that I don't want.
Only entries that begin with 4 numbers are wanted. I can't seem to get how the iterated copy-pasting works; what I've come up with is as follows:
'defining input
Dim dater As Date
dater = Range("B2")
If dater = False Then
MsgBox "Date not specified"
Exit Sub
End If
Dim sheetin As String
sheetin = Range("B5")
If sheetin = "" Then
MsgBox "Input Sheet not specified"
Exit Sub
End If
Dim wbin As String
wbin = Range("B4")
If wbin = "" Then
MsgBox "Input workbook not specified"
Exit Sub
End If
Dim sheetout As String
sheetout = Range("B9")
If sheetout = "" Then
MsgBox "Output Sheet not specified"
Exit Sub
End If
Dim wbout As String
wbout = Range("B8")
If wbout = "" Then
MsgBox "Output Workbook not specified"
Exit Sub
End If
Windows(wbout).Activate
Dim sh As Worksheet, existx As Boolean
For Each sh In Worksheets
If sh.Name Like sheetout Then existx = True: Exit For
Next
If existx = True Then
If Sheets(sheetout).Visible = False Then Sheets(sheetout).Visible = True
Else
Sheets.Add.Name = CStr(sheetout)
End If
'copy pasting values
Windows(wbin).Activate
Sheets(sheetin).Select
'specify maximum row
iMaxRow = 500
For iRow = 1 To iMaxRow
With Worksheets(sheetin).Cells(iRow, 2)
'Check that cell is not empty.
If .Value = "####*" Then
.Copy Destination:=Workbooks(wbout).Worksheets(sheetout).Range("A" & i)
'Else do nothing.
End If
End With
Next iRow
End Sub
Subsequently i'll have to match data to these entries that have been copied over but I figure once i get the hang of how to do iterated stuff it shouldn't be too much of a problem. But right now i'm really stuck... Please help!
It looks like it should work, except for that part :
With Worksheets(sheetin).Cells(iRow, 2)
If .Value = "####*" Then
.Copy Destination:=Workbooks(wbout).Worksheets(sheetout).Range("A" & i)
End If
End With
The third line contains an unknown variable : i.
You need to define it to contain the number of the line to which you're copying. For example, if you want to copy to the first available line, try this :
Set wsOut = Workbooks(wbout).Worksheets(sheetout)
With Worksheets(sheetin).Cells(iRow, 2)
If .Value = "####*" Then
i = wsOut.Cells(wsOut.Rows.Count, 1).End(xlUp).Row + 1
.Copy Destination:=wsOut.Range("A" & i)
End If
End With
Very new at VBA, I need something that sounds simple but I lack the knowledge or terminology to correctly research how to do this.
I need a way to loop through a column (we'll say D) to find value (X) and prompt a dropdown box from range (T2:T160) to replace value X for each individual occurance of X in rows rows 1 to 10000.
At the same for each time X is found, the value in that row for column B needs to be displayed (the user will query an external application to determine which of the values from the range needs to be set for that unique column B value)
1 b
2 y
3 x
4 t
5 x
and end like this
1 b
2 y
3 q
4 t
5 p
I setup my data like this:
Main code:
Sub findReplace()
Dim iReply As Integer
Dim strName As String
strName = InputBox(Prompt:="Enter Text to Search in Column D", Title:="Search Text", Default:="Enter value to find")
If strName = "Enter value to find" Or strName = vbNullString Then
Exit Sub
Else
For Each cell In Range("D1:D5")
If cell.Value = Trim(strName) Then
'Prompt to see if new value is required
iReply = MsgBox(Prompt:="Found " & strName & vbCrLf & "Value in column B is: " & cell.Offset(0, -2).Value & vbCrLf & "Do you wish to replace it?", _
Buttons:=vbYesNoCancel, Title:="UPDATE MACRO")
'Test response
If strName = "Your Name here" Or _
strName = vbNullString Then
Exit Sub
ElseIf iReply = vbYes Then
'Get new value
UserForm1.Show
ValueSelected = UserForm1.ComboBox1.Value
Unload UserForm1
If ValueSelected = vbNullString Or ValueSelected = "" Then
Exit Sub
Else
'Replace value
cell.Value = ValueSelected
End If
ElseIf iReplay = vbCancel Then
Exit Sub
End If
End If
Next cell
End If
End Sub
Setup a UserForm1 to display a drop down list to provide the user a selection option. Code behind form looks like this: (buttons have to be named the same to work correctly)
Private Sub bnt_Cancel_Click()
Unload Me
End Sub
Private Sub btn_Okay_Click()
Me.Hide
End Sub
Private Sub UserForm_Initialize()
'Populate dropdown list in userform
Dim rng As Range
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
For Each rng In ws.Range("T1:T10")
Me.ComboBox1.AddItem rng.Value
Next rng
End Sub
When you run it you'll get this sequence of popups:
I said no to the second replacement value so now my spread sheet looks like this:
I have a table and I have the form I built.
the user pick a name and surname from the table by the combobox in form
the user need to choose from combobox "yes/no" about this name
I need a vba code (excel) so that it can find the name (after the user picked it) in the table
and then update the yes/no column by the correct row.
I created a module and added this:
Option Explicit
Public Sub update_sheet(workername As String)
'--> If the user was selected on the form update column F to Yes
Dim ws As Worksheet
Dim rowno As Long
Set ws = Sheets("workers")
With ws
rowno = .Range("C:C").Find(workername).Row
.Cells(rowno, 6).Value = "Yes"
End With
End Sub
On the form code:
Private Sub cb_select_change()
Call update_sheet(cb_select.Value)
End Sub
where your combo box is called cb_select
You'll need to do some work on this to make it into what you need, but it should get you started:
Private Sub CommandButton1_Click()
Dim rng_ToSearch As Excel.Range
Dim rng_Found As Excel.Range
On Error GoTo ErrorHandler
'Change this to the range that contains your names. I'm assuming that
'it's a single column and has the Yes/No column alongside.
Set rng_ToSearch = Sheet1.Range("MyTable_Names")
'Change the What argument to reflect the name of your form's
'control.
Set rng_Found = rng_ToSearch.Find(What:=Me.ComboBox1.Value, _
After:=rng_ToSearch.Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
'This shouldn't happen if you've populated the name selection
'box correctly and have not allowed users to add to it.
'This is left as an exercise for the reader.
If rng_Found Is Nothing Then
Err.Raise vbObjectError + 2000, , "Either the selected name was " _
& "not found in the list, or no selection was made."
End If
'Again, change the control name to your own.
rng_Found.Offset(0, 1) = Me.ComboBox2.Value
ExitPoint:
On Error Resume Next
Set rng_ToSearch = Nothing
Set rng_Found = Nothing
On Error GoTo 0
Exit Sub
ErrorHandler:
MsgBox "Error in updating users: " & Err.Number & vbCrLf & Err.Description
Resume ExitPoint
End Sub
THIS IS MY CODE SO FAR
Private Sub RefEdit1_BeforeDragOver(Cancel As Boolean, ByVal Data As msforms.DataObject, ByVal x As stdole.OLE_XPOS_CONTAINER, ByVal y As stdole.OLE_YPOS_CONTAINER, ByVal DragState As msforms.fmDragState, Effect As msforms.fmDropEffect, ByVal Shift As Integer)
End Sub
Private Sub ClsFrmE_Click()
Unload Me
End Sub
Private Sub cmdAdd_Click()
Dim lRow As Long
Dim ws As Worksheet
Set ws = Worksheets("workers")
'???รท? ?? ?????? ?????
If Trim(Me.cmbWN.Value) = "" Then
Me.cmbWN.SetFocus
MsgBox "???? ?? ????"
Exit Sub
End If
If Trim(Me.tbDate.Value) = "" Then
Me.tbDate.SetFocus
MsgBox "???? ????? ?????"
Exit Sub
End If
'copy the data to the database
'use protect and unprotect lines,
' with your password
' if worksheet is protected
With ws
' .Unprotect Password:="password"
If Trim(Me.dNdcmb.Value) = "????" Then
.Cells(lRow, 6).Value = 1
Else
.Cells(lRow, 6).Value = 0
End If
.Cells(lRow, 7).Value = Me.tbDate.Value
'.Cells(lRow, 2).Value = Me.cboPart.List(lPart, 1)
' .Protect Password:="password"
End With
'clear the data
Me.cmbWN.Value = ""
Me.tbDate.Value = ""
Me.cmbWN.SetFocus
ActiveWorkbook.Save
End Sub
Private Sub UserForm_Initialize()
Dim cFullName As Range
Dim cDnd As Range
Dim ws As Worksheet
Set ws = Worksheets("workers")
For Each cFullName In ws.Range("??????")
With Me.cmbWN
.AddItem cFullName.Value
.List(.ListCount - 1, 1) = cFullName.Offset(0, 1).Value
End With
Next cFullName
For Each cDnd In ws.Range("??????????")
With Me.dNdcmb
.AddItem cDnd.Value
End With
Next cDnd
Me.dNdcmb.Text = Me.dNdcmb.List(Me.dNdcmb.ListCount - 2)
Me.cmbWN.SetFocus
End Sub