What I'm trying to setup, is for a user to be able to select a row of text from a table and click on a button to have Excel copy the selection to another worksheet and insert to a non-fixed address. Currently, I tried having it search for a specific text and insert the copied row after that text but I ran into Error 91 "Object variable or With block variable not set." If there is a better way to do this, I'm all ear.
Private Sub CommandButton1_Click()
Selection.Copy
Sheets("Form").Select
Dim FoundRange As Range
Dim RangeAddress As Range
Set FoundRange = Sheet3.Cells.Find("SIGN-ON")
RangeAddress = FoundRange.Address
RangeAddress.Selection
Selection.Insert shift:=xlDown
Sheets("MasterList").Select
End Sub
EDIT: Fixed typo in the code.
You were trying to assign a Range.Address property (a string) into a Range object (e.g. RangeAddress = FoundRange.Address) and Selection is a range, not an action like .Select.
Private Sub CommandButton1_Click()
Dim rngToCopy As Range
Dim FoundRange As Range
Set rngToCopy = Selection 'save the current selection so it won't be lost
With Sheets("Form")
On Error Resume Next
Set FoundRange = .Cells.Find("SIGN-ON")
On Error GoTo 0
If Not FoundRange Is Nothing Then
With FoundRange.Resize(rngToCopy.Rows.Count, rngToCopy.Columns.Count).Offset(1, 0)
rngToCopy.Copy
.Insert shift:=xlDown
Application.CutCopyMode = False
End With
End If
End With
End Sub
I've cut down on the operations by getting rid of relying on .Select. See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.
Related
I'm learning VBA and I'm trying to create a workbook wherein in one sheet (sheet2) it would do the calculation then once the calculation is finished the items in sheet2, I would be able to press a commandbutton with the macro of copying the cells in the other sheet (sheet1). I am successful so far in copying over the data however every time the commandbutton is pressed, the error message
'Run-time error'1004': Application-defined or object-defined error'
would pop up. When the debug option is selected it points to line 4 & 5. I searched all over the internet regarding this issue and I haven't stumbled upon any situation like this. I've followed this https://www.youtube.com/watch?v=Z62yORhPr3Q and it's 5th method I'm running with. The code that I have is:
Private Sub CommandButton1_Click()
Dim Part As Range
For Each Part In Range(Range("Q4"), Range("Q4").End(xlDown))
Sheets("VStock").Range(Part.Value).Value = _
Sheets("Calc").Range(Part.Offset(0, 1).Value).Value
Next Part
End Sub
Any help would be appreciated
Thanks!
Suggestion not to loop the entire column and set the Ranges before the main task of "copy/paste".
In your case the ranges are set up incorrectly
Sheets("VStock").Range(Part.Value).Value = _
Sheets("Calc").Range(Part.Offset(0, 1).Value).Value
.Range should Look into the location of cells, example: .Range("Q4:Q144").Value
in your case, Range ends up with .Range(*theValue*).Value
Correct code Example:
Private Sub CommandButton1_Click()
Dim ws1 As Worksheet: Set ws1 = Sheets("Calc")
Dim ws2 As Worksheet: Set ws2 = Sheets("VStock")
Dim SourceRange, dbRange As Range
Dim lRow as Long
lRow = ws1.Range("Q" & ws1.Rows.Count).End(xlUp).Row
If lRow <= 4 Then
MsgBox ("No data to copy")
Exit Sub
End If
Set SourceRange = ws1.Range("Q4:Q" & lRow) ' Calc
Set dbRange = ws2.Range("Q4:Q" & lRow) ' VStock
dbRange.Value = SourceRange.Offset(0, 1).Value
End Sub
trying to figure out an easy way for when someone needs to delete their record from userform data in a spreadsheet. ideally, I want to have the user open up the userform, click delete entry and then an input box would pop up for them to type in their user ID and then the userform would search for that row in the table and delete the entry.
here is a shell of what I'm trying to accomplish:
Option Explicit
Public Sub deleteData(rngColumn As Range, strSelector As String)
Dim rngCell As Range
Dim rngToDelete As Range
Set strSelector = InputBox("Enter Employee ID")
Set rngColumn = ThisWorkbook.Worksheets("Data").Columns(3)
For Each rngCell In rngColumn
If rngCell.Value = strSelector Then
If rngToDelete Is Nothing Then
Set rngToDelete = rngCell
Else
Set rngToDelete = Union(rngToDelete, rngCell)
End If
End If
Next
If Not rngToDelete Is Nothing Then
rngToDelete.EntireRow.Select
End If
End Sub
But it's not doing anything when I try to click the button
Here is a simple code to find a user's input and delete the row.
To add the macro, double-clicking on the UserForm button in design mode will automatically create the Click event. Insert this code in the code window.
'Assign the worksheet variable
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Data")
'Assign the InputBox search string variable
Dim srchID As String: srchID = InputBox("Enter Employee ID")
'Assign a range variable to the cell where the search string is found
Dim trgtCel As Range: Set trgtCel = ws.Range("C:C").Find(What:=srchID, LookIn:=xlValues, lookat:=xlWhole)
'Delete the trgtCel row containing the Employee's Information
trgtCel.EntireRow.Delete
On the sheet named "Data" I have an Excel Table. This table has a variable number of rows, typically 20k to 30k. Column A is "JobNo"
On the sheet named "Main" I have cell where I show the "JobNo". That value starts as the first visible JobNo from the filtered table.
I have buttons for "Next Record". When I click this button and run it's associated VBA code, I need that code to move the "Data" sheet's cell pointer to the next visible (filtered) value in column A.
I've tried several samples of code found here to find the first visible cell, and to move to the next visible cell, but most of them relied on "Activecell". I need to move a "virtual" pointer to the next visible cell because that sheet, where the table is located is not visible and so the ActiveCell is not there.
This for example works to move the cell pointer to the next visible cell, but it only works if "Dat" sheet is selected:
Sub movetest()
Sheets("Data").Range("A1").EntireColumn.SpecialCells(xlCellTypeVisible).Find(What:="*", After:=ActiveCell).Activate
End Sub
What I need is something that can do what the above line does, but do it to a sheet that is not selected. Bonus to me if it was in structured table syntax.
I also tried to use some variant of this, which moves to the first visible cell, but only when the "Data" sheet is selected:
Range("Data[[#All],[PACEJob]]").SpecialCells(xlCellTypeVisible).Find _
(What:="*", After:=ActiveSheet.Range("Data[[#Headers],[PACEJob]]"), _
LookIn:=xlFormulas, lookat:=xlPart, searchorder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
EDIT:
This does what I need for non filtered table. Just need to replicate this to do the same thing with a filtered table and only show visible.
(GLobal selectedRow)
selectedJobRow = selectedJobRow + 1
Sheets("Main").Range("O2").Value = Sheets("Data").Range("A" & selectedJobRow).Value
I gave up trying to work around the sheet not being active and Activecell. This seems to work, although it seems like there would be a more elegant way, No?
Sub movePointerDown()
Application.ScreenUpdating = False
Set wksToCheck = Sheets("Data")
Sheets("data").Select
Sheets("Data").Range("A1").EntireColumn.SpecialCells(xlCellTypeVisible).Find(What:="*", After:=ActiveCell).Activate
Sheets("Main").Range("O2").Value = ActiveCell.Value
Sheets("Main").Select
Application.ScreenUpdating = False
End Sub
And its companion:
Sub movePointerUp()
Application.ScreenUpdating = False
Set wksToCheck = Sheets("Data")
Sheets("data").Select
Sheets("Data").Range("A1").EntireColumn.SpecialCells(xlCellTypeVisible).Find(What:="*", After:=ActiveCell, Searchdirection:=xlPrevious).Activate
Sheets("Main").Range("O2").Value = ActiveCell.Value
Sheets("Main").Select
Application.ScreenUpdating = False
End Sub
Don't need to work with ActiveCell if you use Excel objects, there is plenty of information about the subject on the internet.
This proposed solution returns the next Cell record, and it's wrapped in a Function
to allow for flexibility. It uses a Static variable to keep track of actual record (see link provided for details) and validates the ListObject (excel Table) field, its AutoFilter and whether the actual record is the last visible record.
Function ListObject_ƒNextVisibleCell(rOutput As Range, sMsgOut As String, sFld As String) As Boolean
Static rCll As Range
Const kMsg1 As String = "Field [ #FLD ] not found."
Const kMsg2 As String = "ListObject filter returned zero records"
Const kMsg3 As String = "Actual record is the last visible record"
Dim wsDATA As Worksheet
Dim lo As ListObject
Dim rTrg As Range
Dim rCllLast As Range
Set wsDATA = ThisWorkbook.Worksheets("DATA")
Set lo = wsDATA.ListObjects("lo.DATA") 'update as required
With lo
On Error Resume Next
Rem Validate Field
Set rTrg = .ListColumns(sFld).DataBodyRange
If rTrg Is Nothing Then
sMsgOut = Replace(kMsg1, "#FLD", sFld)
Exit Function
End If
Rem Validate ListObject AutoFilter
Set rTrg = Nothing
Set rTrg = .ListColumns(sFld).DataBodyRange.SpecialCells(xlCellTypeVisible)
If rTrg Is Nothing Then sMsgOut = kMsg2: Exit Function
On Error GoTo 0
End With
Select Case (rCll Is Nothing)
Case True
Rem No Previous Record
Set rCll = rTrg.Cells(1)
Case False
With lo.ListColumns(sFld).DataBodyRange
Rem Validate Last Record
Set rCllLast = rTrg.Areas(rTrg.Areas.Count).Cells(rTrg.Areas(rTrg.Areas.Count).Cells.Count)
If rCll.Address = rCllLast.Address Then
sMsgOut = kMsg3
Exit Function
Else
Rem Reset Visible Cells Range
Set rTrg = Range(rCll.Offset(1), .Cells(.Cells.Count))
Set rTrg = rTrg.SpecialCells(xlCellTypeVisible)
Rem Set Next Record
Set rCll = rTrg.Cells(1)
End If: End With: End Select
Rem Set Results
Set rOutput = rCll
ListObject_ƒNextVisibleCell = True
End Function
It should be called in this manner
Sub ListObject_ƒNextVisibleCell_TEST()
Const kTitle As String = "ListObject Next Visible Cell"
Dim wsMain As Worksheet, rCll As Range
Dim sFld As String, sMsg As String
sFld = "JobNo"
Set wsMain = ThisWorkbook.Worksheets("Main")
If ListObject_ƒNextVisibleCell(rCll, sMsg, sFld) Then
wsMain.Range("O2").Value2 = rCll.Value2
Else
MsgBox sMsg, vbCritical, kTitle
End If: End With
End Sub
Suggest to check the following pages for details about the resources used:
Worksheet object (Excel)
ListObject object (Excel)
Application.Range property (Excel)
With statement
MsgBox function
I've created a macro to print the range of cells and it's content in the console. The macro is doing just fine. However, the problem is I can't use a button (in another sheet) conected to that macro. To be clearer - I created a macro-enabled button in sheet2 whereas the range of cells I wanaa select and print are within sheet1.
I've tried so far:
Sub LoopAndPrintSelection()
Dim ocel As Range, RangeSelected As Range
Set RangeSelected = Application.Selection
For Each ocel In RangeSelected.Cells
Debug.Print ocel.Address, ocel.value
Next ocel
End Sub
How can I refer the range of selection to any specific sheet?
As others have already mentioned, the "Application.Selection" property will refer to what you have selected in your active sheet. I would recommend that you assign a hotkey to this macro and then you can select the cells you want to print and use the macro's hotkey.
This is one possible solution, but if you need that button on a different sheet and want people to interact with the button (rather than a hotkey) then this won't solve your issue.
This should help with the issue of two different tabs
Sub DUMMY_TEST()
Dim myAREA As Range
Dim mySELECTION As Range
On Error GoTo error_spot
'Stop Excel from "blinking" as tabs are selected/changed and calculating.
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set mySELECTION = Application.Selection 'Used to get back to same spot after code has executed
If Sheets("Sheet1").Visible = True Then
Sheets("Sheet1").Activate
Else
'tab not visible, end sub
GoTo error_spot
End If
Set myAREA = Application.Selection
For Each ocel In myAREA.Cells
Debug.Print ocel.Address, ocel.Value
Next ocel
mySELECTION.Worksheet.Activate
mySELECTION.Select
error_spot:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
This question already has answers here:
Can I Get the Source Range Of Excel Clipboard Data?
(3 answers)
Closed 2 years ago.
I know about Application.CutCopyMode, but that only returns the state of the CutCopyMode (False, xlCopy, or xlCut).
How do I return the address of the currently copied range in Excel using VBA? I don't need the currently selected range (which is Application.Selection.Address). I need the address of the range of cells with the moving border (marching ants) around it.
In other words, if you select a range of cells, hit CTRL+C, and then move the selection to another cell, I need the address of the cells that were selected when the user hit CTRL+C.
Thanks!
As far as I know you can't do that with vba. You can however code your own copy sub and store the source in a global variable.
Something like this:
Option Explicit
Dim myClipboard As Range
Public Sub toClipboard(Optional source As Range = Nothing)
If source Is Nothing Then Set source = Selection
source.Copy
Set myClipboard = source
End Sub
10 years later you still can't refer directly to a copied Range
(shown by the "marching ants border" aka "dancing border", "moving border").
But you can get its address by copying the cells as link to a temporary worksheet. There you can collect the desired range's address.
Private Sub ThereAreTheMarchingAnts()
Dim rngCopied As Range ' the copied range with the marching ants border
Dim rngSelected As Range ' the selected range
Dim tmpWorksheet As Worksheet ' a temporary worksheet
Dim c As Range ' a cell for looping
' Exit, if nothing was copied (no marching ants border):
If Not (Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut) Then Exit Sub
' Exit, if no range is selected (just for demonstration)
If Not TypeName(Selection) = "Range" Then Exit Sub
' remember selected Range:
Set rngSelected = Selection
' add a temporary sheet and paste copied cells as link:
Set tmpWorksheet = ActiveWorkbook.Sheets.Add
tmpWorksheet.Paste link:=True
' go through all pasted cells and get the linked range from their formula:
For Each c In tmpWorksheet.UsedRange
If rngCopied Is Nothing Then
Set rngCopied = Range(Mid(c.Formula, 2))
Else
Set rngCopied = Union(rngCopied, Range(Mid(c.Formula, 2)))
End If
Next c
' delete the temporary worksheet without asking:
Application.DisplayAlerts = False
tmpWorksheet.Delete
Application.DisplayAlerts = True
' show the addresses:
MsgBox "Copied Range: " & rngCopied.Address(0, 0, xlA1, True) & vbLf & _
"Selected Range: " & rngSelected.Address(0, 0, xlA1, True)
End Sub
The code also works with multiranges and also if the copied range and the selected range are on different sheets.
When you copy a Range, the address is copied to the Clipboard along with other formats. You can check that with Clipboard Viewer application.
So if you need the copied Range, get it from Clipboard. It will be something like> $A2:$B5 or similar
The only way i can think of doing this is tracking the last range selected with a global variable and then waiting until you think a copy action is done. Unfortunately neither is easy.
The following is a quick attempt that has two problems;
If you copy the same data twice it
isn't updated
If a copy or paste is
fired from another app, the results
may vary.
This is one of those last hope tricks when tracking events that don't really exist. Hope this helps.
''# Add a reference to : FM20.dll or Microsoft Forms 2.0
''# Some more details at http://www.cpearson.com/excel/Clipboard.aspx
Option Explicit
Dim pSelSheet As String
Dim pSelRange As String
Dim gCopySheet As String
Dim gCopyRange As String
Dim gCount As Long
Dim prevCBText As String
Dim DataObj As New MSForms.DataObject
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
ByVal Target As Excel.Range)
CopyTest
pSelSheet = Sh.Name
pSelRange = Target.Address
''# This is only so you can see it working
gCount = gCount + 1
application.StatusBar = gCopySheet & ":" & gCopyRange & ", Count: " & gCount
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
CopyTest ''# You may need to call CopyTest from other events as well.
''# This is only so you can see it working
gCount = gCount + 1
application.StatusBar = gCopySheet & ":" & gCopyRange & ", Count: " & gCount
End Sub
Sub CopyTest()
Dim curCBText As String
Dim r As Range
DataObj.GetFromClipboard
On Error GoTo NoCBData
curCBText = DataObj.GetText
On Error Resume Next
''# Really need to test the current cells values
''# and compare as well. If identical may have to
''# update the gCopyRange etc.
If curCBText <> prevCBText Then
gCopySheet = pSelSheet
gCopyRange = pSelRange
prevCBText = curCBText
End If
Exit Sub
NoCBData:
gCopySheet = ""
gCopyRange = ""
prevCBText = ""
End Sub
Oh and excuse the wierd comments ''# they're just there to help the syntax highlighter of SO.
I think you can use this method
https://learn.microsoft.com/en-us/office/vba/api/Excel.Application.OnKey
This method assigns a function to the hot key Ctrl+C, every time this combination is used, the function will be triggered and you can get the address of the range.