I have an issue which i can't solve.I wrote this code:
Private Sub CommandButton2_Click()
Sheets("sheet2").OLEObjects("CheckBox1").Copy
Sheets("sheet3").Range("V7").PasteSpecial
End Sub
This code copy a checkbox from (sheet 2) to (sheet 3) starting from V7 cell. Now I want the next time I press the command button to paste the data to cell V12,next time to V17 etc. My vba knowledge is not very good as you can see.
This code will see how many checkboxes are already in the sheet you are pasting to and add 5 rows for each check box, then paste five rows under the last one.
Private Sub CommandButton2_Click()
' copy checkbox
Sheets("sheet2").OLEObjects("CheckBox1").Copy
Dim wks As Worksheet
Set wks = Sheets("Sheet3")
Dim cb As OLEObject, i As Integer
'determine how many boxes are already there and get count of cell to paste to
i = 7
For Each cb In wks.OLEObjects
If InStr(1, cb.Name, "CheckBox") Then i = i + 5
Next
'paste new checkbox
Sheets("sheet3").Range("V" & i).PasteSpecial
End Sub
Use a global variable. These must be at the top of your sheet, module, or form code above all subs and functions.
Then use that as the row number in your range. Range("V" & lRow)
Private lRow As Long
Private Sub CommandButton2_Click()
'Let's check if this is the first time the button has been used.
If lRow = 0 then
lRow = 7
Else
'Increment the row from the one we wrote to last time.
lRow = lRow + 5
End If
'Do the copy
Sheets("sheet2").OLEObjects("CheckBox1").Copy
Sheets("sheet3").Range("V" & lRow).PasteSpecial
End Sub
I dont know what data you got between in Sheet(3).Range("V7") and Sheet(3).Range("V12")
but juste before you're PasteSpecial, you shoud keep track where was the last time you paste data in Sheets("sheets3") in a specific cell in Sheet("sheets3"), in exemple : Sheets("Sheet3").Range("A1")
Then you'll be able to pastespecial to this cell 5 row under like this :
Sheets("sheet3").Range(Sheets("Sheets3").Range("A1").Offset(5,0)).PasteSpecial
right after that you update the Sheets("Sheets3").Range("A1") = Sheets("sheet3").Range(Sheets("Sheets3").Range("A1").Offset(5,0)).Address
So this should do the work :
Private Sub CommandButton2_Click()
Dim oWsSource as Worksheet
Dim oWsDestination as Worksheet
Set oWsDestination = ThisWorkbook.Worksheet("Sheets3")
Set oWsSource = ThisWorkbook.Worksheet("Sheets2")
'Do the copy
oWsSource.OLEObjects("CheckBox1").Copy
oWsDestination.Range(oWsDestination.Range("A1").Value).Offset(5,0)).PasteSpecial
oWsDestination.Range("A1").Value = oWsDestination.Range(oWsDestination.Range("A1").Value).Offset(5, 0)).Address
End Sub
All the answers put the first checkbox but the next one put it again to the same cell as before.I don't know if its matter but I use excel 2010.
Related
Hope you can help me.
I want to copy and paste a cells value based on when you click a hyperlink on that cell.
So for example, I have a sheet called Form1, I want to click on an ID in column A it will then copy the value of that cell and paste it to B2 in sheet1 and then take me to sheet 1.
Currently I have a macro that allows me to click on an active cell and then press a button which then does what is mentioned above. I just think a hyperlink press would be more user friendly and would result in less errors.
Here is the code I have at the moment:
Sub Rectangle13_Click()
ActiveCell.Copy Destination:=Sheets(“Sheet1”).range(“B2”)
Worksheets(“Sheet1”).Activate
End Sub
Any help would be appreciated! Thank you
Worksheet FollowHyperLink
Copy this code to the sheet module of worksheet Form1. From there, run the second sub to convert the A column to hyperlinks.
Click away.
Option Explicit
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
If Not Intersect(Columns("A"), Target.Range) Is Nothing Then
Me.Parent.Worksheets("Sheet1").Range("B2").Value = Target.Range.Value
End If
End Sub
' Run this to create hyperlinks out of the values in column 'A'
' which will point to cell 'B2' in 'Sheet1'. You can then reformat
' the cells (remove underline, change font color, ...).
Private Sub CreateHyperlinks()
Dim lRow As Long: lRow = Range("A" & Rows.Count).End(xlUp).Row
Dim cell As Range
For Each cell In Range("A2:A" & lRow).Cells
cell.Hyperlinks.Add cell, "", "Sheet1!B2", , CStr(cell.Value)
Next cell
End Sub
It is inconvenient to use Hyperlik, I think. If you try changing the cell value, you cannot simple click it and write something... But if you want that, you can create such a hyperlink in the next way:
Sub testAddHyperlink()
Dim DestSh As Worksheet
Set DestSh = Sheets("Sheet1") 'you can use any sheet name here
ActiveSheet.Hyperlinks.Add Range("A1"), Address:="", SubAddress:="'" & DestSh.name & "'" & "!A1"
'it will keep the existing cell value
End Sub
Then, please copy the next event code in the sheet code module (where the hyperlink exists):
Option Explicit
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim rngCopy As Range, shDest As Worksheet
Set shDest = Sheets("Sheet1") 'you may use here any sheet name
shDest.Range("B2").value = Target.Parent.Value 'the sheet where the hyperlink targets, is already activated...
End Sub
If you want to use the BeforeDoubleClick approach, paste this code into your Form1 worksheet object in the VBA editor ...
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Cells.Count = 1 And Target.Cells(1, 1).Column = 1 Then
Cancel = True
With ThisWorkbook.Worksheets("Sheet1")
.Range("B2") = Target.Value
.Activate
End With
End If
End Sub
... naturally, this is a base example and you may need to modify it accordingly. For example, when you double click, you may want to ignore the first row if it's a header and not invoke the core parts of the logic.
That will then do what you want.
I am trying to copy multiple columns from multiple worksheets into a new worksheet in Excel using a VBA Macro.
I have already created the worksheet, and I want to paste specific columns one after another in that worksheet.
I would like to copy from each worksheet all columns including and beyond a certain column, in all worksheets including and from Column F.
I have written a piece of code that selects the appropriate data and loops correctly.
However, i get a "run-time error 1004", when the loop hits a worksheet where I am copying only one column.
I know this is because of the choice of my code. However, I don't know how to solve the problem.
The problem is that my code selects a range to the end of the worksheet when there is only one column being selected. This creates a copied area too big to paste in the new worksheet.
Dim i As Integer
i = 1
Do While i <= Worksheets.Count - 1
Worksheets(i).Select
'Select, Copy and Paste Data
RangeFromF1
Selection.Copy
Worksheets("Combined").Select
Range("X1").Select
Selection.End(xlToLeft).Select
ActiveCell.Offset(0, 1).Select
ActiveSheet.Paste
i = i + 1
Loop
End Sub
Public Sub RangeFromF1()
Range("F1", Range("F1").End(xlDown).End(xlToRight)).Select
End Sub
Instead of going from column F to the right, try going from the last column to the left.
Public Sub RangeFromF1()
Range("F1", Cells(1, Columns.Count).End(xlToLeft).End(xlDown)).Select
End Sub
You might also want to get rid of all the Select stuff.
Sub CopyStuff()
Dim i As Long
i = 1
Do While i <= Worksheets.Count - 1
With Worksheets(i)
.Range("F1", .Cells(1, .Columns.Count).End(xlToLeft).End(xlDown)).Copy
Worksheets("Combined").Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).Paste
i = i + 1
End With
Loop
End Sub
Before coming back to check for your answer noris, I figured out a way, to do as you suggested, with the following code:
Public Sub ReferenceSelection()
Dim startcell As Range
Set startcell = Range("A1").End(xlDown).End(xlToRight)
Range(startcell, ("F1")).Select
End Sub
Hy, I am using Microsoft Excel as an Integrated Google Map. It working fine for one row. Here is its code.
Private Sub CommandButton1_Click()
WebBrowser1.Navigate ActiveSheet.Range("D2").Value
End Sub
Basically what i want, I want when I click on the Next Map, the row 3 shold be populate in the map. It works fine for one record at a time and only for D2. But I want when I move "Next Map" button it should work for D3 and other as like for D2.
I am using below code but it does not work.
Sub SelectC()
Dim x As Variant
x = Cells(ActiveCell.Row, "D").Offset(1).Select
WebBrowser1.Navigate ActiveSheet.Range.Selection.Value
End Sub
It gives an error as under.
Please guide me where I am writing wrong code. thanks
I would do this slightly different. I would completely avoid the use of Activecell/Selection etc. You may want to see How to avoid using Select in Excel VBA
I will use 1 cell to store the current row number and use that. Here is an example. I am going to use say Cell D1 and make its font white so that it will not show. For demonstration purpose, I am not making it white. Change it to whatever you want. You have asked for NEXT button. I am also including a code which you can use for PREVIOUS.
See this example
Option Explicit
Dim ws As Worksheet
Dim lRow As Long
Dim NextRow As Long
Sub NextMap()
'~~> Set this to the relevant worksheet
Set ws = Sheet1
With ws
'~~> Get last row of the Col D
lRow = .Range("D" & .Rows.Count).End(xlUp).Row
'~~> Get the next row
NextRow = .Range("D1").Value2 + 1
'~~> Check if it is greater than last row
If NextRow > lRow Then
MsgBox "End of data reached"
Else
'WebBrowser1.Navigate .Range("D" & NextRow).Value2
'~~> Store the row number in D1
.Range("D1").Value = .Range("D1").Value + 1
End If
End With
End Sub
Sub PreviousMap()
Set ws = Sheet1
With ws
NextRow = .Range("D1").Value2 - 1
If NextRow < 2 Then
MsgBox "Begining of data reached"
Else
'WebBrowser1.Navigate .Range("D" & NextRow).Value2
.Range("D1").Value = .Range("D1").Value - 1
End If
End With
End Sub
In ACTION
Minimally, the code WebBrowser1.Navigate ActiveSheet.Range.Selection.Value should be changed to something along the lines of WebBrowser1.Navigate ActiveCell.Value. The syntax you originally used is poorly formed.
I need a small loop that cuts a row and inserts it at the row 2 for every worksheet.
The entire row should be detected or selected by only selecting a single cell in the first column.
I've tried adding a simple for each to the code (see below) but it end up sorting the every row by date.
Private Sub CommandButton2_Click()
For Each Worksheet In ThisWorkbook
Rows(ActiveCell.Row).Cut
Rows(2).Insert Shift:=xlDown
Next
End Sub
It should move the entire row, in every worksheet, to the top of the list by only selecting a cell and pressing the commandbutton in the first worksheet.
The entire row should be detected or selected by only selecting a single cell in the first column.
If someone could also explain how to work with Activevell and a loop through every worksheet that would be nice as well.
Well the bare minimum of code you are trying to use would look like:
Private Sub CommandButton2_Click()
For Each ws In ThisWorkbook.Sheets
ws.Rows(ActiveCell.Row).Cut
ws.Rows(2).Insert Shift:=xlDown
Next ws
End Sub
This would loop through all elements (sheets) in the sheets collection of the current workbook. Activecell is a reference to the focussed cell currently displayed on the active sheet, the sheet as where you press the commandbutton (assumed) as per your statement:
"It should move the entire row, in every worksheet, to the top of the list by only selecting a cell and pressing the commandbutton in the first worksheet."
I am not a big fan of For Each loop, that's why I'm using just for next loop :)
I think it should be useful :)
Private Sub CommandButton2_Click()
Dim numb As Integer
Dim i As Integer
Dim pos As Integer
numb = Application.Worksheets.Count
For i = 1 To numb
With Sheets(i)
.Select
pos = ActiveCell.Row
.Rows(pos).Cut
.Rows(2).Insert shift:=xlDown
End With
Next i
End Sub
If You still need answer for your last sentence add a comment, hope it helps :)
I'm 15 and I'm doing a Internship as a Developer and I've got a kinda hard exercise.
I have a Table with 3 columns, A is "Number" B is "percent" and C is "Value". The column "value" is blank and I Need to calculate the value with a macro button. I've tried this, but it was wrong because I didn´t calculate it in VBA:
Public Sub PushButton ()
Range("C2:C11").Formula = "=A2*B2/100"
Range("C2:C11").Value = Range("C1:C6).Value
End Sub
How do I solve this?
You are using a defined range, you could do it with a dynamic range like this:
Option Explicit
Sub PushButton()
Dim i As Long, LastRow As Long
With ThisWorkbook.ActiveSheet
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row 'first you need to find the last row on the active sheet
For i = 2 To LastRow 'then iterate through all the rows starting from 2, if row 1 has headers
.Cells(i, 3) = .Cells(i, 1) * .Cells(i, 2) / 100
Next i
End With
End Sub
If you need help understanding this code, let me know.
Edit: Explanation
Well, the first thing you must do is Dimension all your variables, and to help that you can use the Option Explicitright above all your code.
I've dimensioned 1 variable for the loop and another one to find the last row with text.
To find the last row what you are actually doing is going to excel, select the last row (1048576) and the column where it will have text, in this case 1 or column "A" and then pushing ctrl+Up excel and vba will get you to the last cell with text.
To do that you use Cells(Row, column) instead of manually inserting row 1048576 you can just use rows.count and it will be the same.
Once you get the last row you just iterate with a For iloop meaning For a variable called i which equals 2 (For i = 2) To LastRow (to the last row you calculated) VBA will repeat the code in between the ForAnd Next adding 1 number to i everytime the loop restarts.
In this case is just adding a number to the rows on Cells(i, 3) so you can modify that cell depending of its i value.
I think you need to question why Excel needs to calculate on demand rather than automatically like normal. Failing that there are a few options
You could change your calculation method to Manual using the following in the ThisWorkbook object
Option Explicit
Dim xlCalcMethod As XlCalculation
Private Sub Workbook_Open()
With Application
' Store users current method for when closing the workbook
xlCalcMethod = .Calculation
.Calculation = xlCalculationManual
End With
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
' Reset calculation
Application.Calculation = xlCalcMethod
End Sub
and then when the button is pressed use the following code to calculate placed in a Module
Option Explicit
Public Sub Button_Click()
Application.Calculate
End Sub
Another option to do this without looping would be:
Sub CalculateRange()
Dim rng As Range
' Update for your Range
With ActiveSheet
Set rng = .Range("C2:C" & .Cells(.Rows.Count, "A").End(xlUp).Row)
End With
rng.Value2 = Evaluate(rng.Offset(0, -2).Address & "*" & rng.Offset(0, -1).Address & "/100")
End Sub
Finally, the way you've come up with is perfectly acceptable as VBA