I'm new to vba and I can't manage to do what I want although it's very simple.
I need to automatically add textbox values from a userform to my second sheet. For example in each textboxes I provide an integer and I want to put this values 1 by 1 on the range C5:C52.
I have the following code that loop trough my textbox collection and range C5:C52
Sub remplissageTab()
Dim rng As Range
Dim cell As Range
Set rng = Sheets("Câbles").Range("C5:C52")
For Each txtBox In clcTxt
For Each cell In rng
cell.Value = CInt(txtBox)
Next cell
Next txtBox
Unload Me
End Sub
However the results is not what I expect. It only prints the last textbox value through all ranges. But I want all values in the same order textboxes are created.
I hope I made clear explanations.
What do you think ?
Thanks a lot for your help. Lyess
Like so:
Sub remplissageTab()
Dim rng As Range
Dim Rw as Long
Set rng = Sheets("Câbles").Range("C5:C52")
For Each txtBox In clcTxt
rng.Offset(Rw).Value = CInt(txtBox)
Rw = Rw + 1
Next txtBox
Unload Me
End Sub
Related
I'm trying to build a VBA application that checks for a certain value, then adds a row on top for each time this value is found.
Sub copy()
Dim rng As Range
Dim row As Range
Dim cell As Range
Set rng = Range("B2:B10")
For Each row In rng.Rows
For Each cell In row.Cells
If cell.value = "test" Then
MsgBox "found" + cell.Address
cell.EntireRow.Insert
End If
Next cell
Next row
End Sub
Every time I try to run this function, however, it keeps adding rows on top of each other continuously and not for each occurrence.
If you loop the cells from top to bottom, adding the row will push your original range down, causing the next loop to evaluate the previous cell.
To avoid this, loop backwards (i.e. bottom to top):
Sub copy_test()
Dim rng As Range
Set rng = Range("B2:B10")
Dim i As Long
For i = rng.Cells.Count To 1 Step -1
If rng.Cells(i).Value = "test" Then
Debug.Print "Found"
rng.Cells(i).EntireRow.Insert
End If
Next i
End Sub
Note: Set rng = Range("B2:B10") is telling VBA that you are referring to Cells B2:B10 of the ActiveSheet which might not be what you want.
Please fully qualify your range to avoid this. (e.g. ThisWorkBook.Worksheets("Sheet1").Range("B2:B10") or use the code name of the worksheet Sheet1.Range("B2:B10").)
I have checkboxes that are LINKED to their own respective cells. When I check checkbox1, I want all the checkboxes in a specific range to be checked/unchecked.
Here is what I Used but it's not working. It's giving me error Object variable or With block variable not set.
Sub SelectAll_Click()
Dim xCheckBox As CheckBox
Dim rng As Range, cell As Range
Set rng = Range("B19:B28")
For Each cell In rng
If xCheckBox.Name <> Application.ActiveSheet.CheckBoxes("Check Box 1").Name Then
xCheckBox.Value = Application.ActiveSheet.CheckBoxes("Check Box 1").Value
End If
Next cell
End Sub
Thank you
To toggle a checkbox that is linked to a cell you can simply set the cell value (or return value from a formula) to either True or False.
Using your example it would look something like:
Sub SelectAll_Click()
Dim xCheckBox As CheckBox
Dim rng As Range, cell As Range
Set rng = Range("B19:B28")
For Each cell In rng
cell.value = True
Next cell
End Sub
If you need logic based on the checkbox itself then you would instead loop the checkboxes rather than the a range.
Private Sub demoLoopingCheckboxes()
Dim control As OLEObject
For Each control In ActiveSheet.OLEObjects
With control
' The type of activex control
' Use this is a if statement to limit to only "CheckBox"
Debug.Print TypeName(.Object)
' The cell Address to the linked cell
Debug.Print .LinkedCell
' Can read/write the value to the checkbox itself
Debug.Print .Object.Value
End With
Next control
End Sub
I hope someone can help me with this as it's driving me up the wall!
There are 5 non-contiguous cells in a worksheet that I want to copy to the next empty row on another worksheet whilst retaining the number formatting (which varies). I have this so far but am struggling working out how to retain formatting. Can anyone please help? Thanks I anticipation.
`With wsCalc
For bRun = 1 To 4
bData(bRun) = Application.Choose(bRun, .Range("g2"), .Range("b2"), .Range("R2"), .Range("Q14"))
Next bRun
End With
wSResults.Cells(Rows.Count, "a").End(xlUp).Offset(1).Resize(, 4).Value = bData
`
Here's a possible solution, using your hard-coded cell addresses. You will have to set wsCalc and wsResults to their proper worksheets. Slightly more elegant would be to define a "non-contiguous" range on your wsCalc sheet (select the 1st cell, keep Ctrl pressed and select the next one etc, then type a name in the drop-down box just to the left of the formula bar).
Option Explicit
Sub CopyWithFormat()
Dim wsCalc As Worksheet
Set wsCalc = ActiveSheet 'Or whatever your calc sheet is
Dim rngSource As Range
Set rngSource = wsCalc.[G2,B2,R2,Q14]
Dim wsResults As Worksheet
Set wsResults = ActiveSheet 'Or whatever your result sheet is
Dim clDest As Range
Set clDest = wsResults.Cells(Rows.Count, "a").End(xlUp).Offset(1)
Dim cl As Range
For Each cl In rngSource.Cells
clDest.Value = cl.Value
clDest.NumberFormat = cl.NumberFormat
Set clDest = clDest.Offset(1)
Next cl
End Sub
Instead of using .Value, try .Text. It retains formatting. See below.
Gary's Student is right, text is read only, it should be used for the input not the output.
bData(bRun) = Application.Choose(bRun, .Range("g2").Text, .Range("b2").Text, .Range("R2").Text, .Range("Q14").Text)
I also agree with other answer the entire code could be set up more straight forward.
I have table like this, but bigger.
My code:
Sub copy()
Range("A2").Copy
End Sub
I want the button to adapt to the cell next to it as I copy it. From say, A2 to A3 to A4 etc.
This does essentially what you are trying to do:
Sub Test()
Dim rw As Long
With ThisWorkbook.Sheets("Sheet1") 'Change accordingly
rw = .Shapes(Application.Caller).TopLeftCell.Row
.Cells(rw, 1).Copy
End With
End Sub
Assign this macro to all the buttons you have created in the cells on column B
If you need this on more buttons for example column D and F, and you want to copy respectively C and E, you could use a more generic piece of code:
Sub Test()
Dim rw As Long, cl As Long
With ThisWorkbook.Sheets("Sheet1")
rw = .Shapes(Application.Caller).TopLeftCell.Row
cl = .Shapes(Application.Caller).TopLeftCell.Column
.Cells(rw, cl - 1).Copy
End With
End Sub
Your question is quite unclear.
If you are looking for a macro that would allow your button to copy the cell to its left,
you make your button as a range.
When you select, obtain the column and row of your selection.
Sub copy()
Dim TargetCell As Range
Set TargetCell = Selection
TargetCell(ActiveCell.column - 1, ActiveCell.row).Copy
End Sub
I hope this might be helpful to you in any way.
I'd like to create a macro that selects a rectangular range of cells and sets the name of every one of those cells to the value/contents of the cell.
In terms of what I've thought so far, I get an error though with the cell.Name line.
Public Sub NameCell()
Dim rng As Range
Dim cell As Range
Set rng = Range("A1:D1")
For Each cell In rng
cell.Name = CStr(cell.Value)
Next
End Sub
Is this what you meant?
Sub setVal()
Range("A1:C6").Select
Selection = "value"
End Sub
I believe this may work for you unless I also misunderstood the question.
Dim r As Range
Dim cell As Range
Set r = Sheet1.UsedRange
For Each cell In r
Sheet1.Names.Add Name:=cell.Value, RefersTo:=cell
Next
Keep in mind, though, that you would want to check that the cell.Value is valid (no spaces, etc.) for a named range.
To replace a range of cells with their values (removing any formulas from the range), you would use something like this.
Public Sub NameCell()
Dim rng As Range
Set rng = Range("A1:D1")
rng.Value = rng.Value
End Sub