This is my first post, so please provide any feedback about my approach to presenting the problem.
I'm building a sub that (ultimately) is supposed to copy a range from one sheet ("Sandbox") to another ("Master"). The steps are:
Identify the selected rows
Loop through the Sandbox rows, determining whether to find a matching Master row or add as a new end-row in Master
Copy the values only from each selected Sandbox row to the appropriate Master row
The error pops with the setting the range for the PasteSpecial function. That line consistently gives a "1004 (Method 'Range' of object '_Global' failed" message.
Here's the code :
Sub UpdateMaster()
Dim currentSelection As Range
Set currentSelection = Selection
Dim sheetSB As Worksheet
Set sheetSB = ThisWorkbook.Sheets("Sandbox")
Dim sheetMaster As Worksheet
Set sheetMaster = ThisWorkbook.Sheets("Master")
Dim lastTargetRow As Integer
lastTargetRow = sheetMaster.Range("IDRange").End(xlDown).Row + 1
Dim startingTargetColumn As Integer
startingTargetColumn = sheetMaster.Range("IDRange").Column
Dim thisID As String
Dim thisStatus As String
For Each thisrow In currentSelection.Rows
' Capture the current ID value
thisID = Cells(thisrow.Row, Range("IDRange").Column).Value
' Capture the current Status value
thisStatus = Cells(thisrow.Row, Range("NewRange").Column).Value
' If the row has no ID...
If thisID = "" Then
' ...do nothing
' If the row is flagged as new...
ElseIf thisStatus = "New" Then
'...identify the first blank row, and set all data columns to be copied
Range(Cells(thisrow.Row, Range("IDRange").Column), Cells(thisrow.Row, Range("LastSandboxColumn")).Column).Copy _
Destination:=sheetMaster.Range(lastTargetRow, startingTargetColumn)
' Increment the next available last row by 1
lastTargetRow = lastTargetRow + 1
Else
' Otherwise, find the corresponding row and set the non-ID columns to be copied
Dim sourceColumn1 As Integer, sourceColumn2 As Integer
Dim targetRow As Integer, targetColumn As Integer
Dim matchRow As Integer
sourceColumn1 = Range("IDRange").Column + 1
sourceColumn2 = Range("LastSandboxColumn").Column
targetRow = Application.WorksheetFunction.Match(thisID, sheetMaster.Range("IDRange"), 0)
targetColumn = startingTargetColumn + 1
Range(Cells(thisrow.Row, sourceColumn1), Cells(thisrow.Row, sourceColumn2)).Copy
Range(sheetMaster.Cells(targetRow, targetColumn)).PasteSpecial xlPasteValues
End If
Next
End Sub
The error is happening on the last line:
Range(sheetMaster.Cells(targetRow, targetColumn)).PasteSpecial xlPasteValues
Inexplicably, the following seems to work:
Range(Cells(thisrow.Row, sourceColumn1), Cells(thisrow.Row, sourceColumn2)).Copy _
Destination:=Range(sheetMaster.Cells(targetRow, targetColumn))
Unfortunately, I want only the values; bringing over formulas and formatting will screw up other behavior in the sheet.
I have tried many variations, but essentially it will not allow me to create a range, referencing Master, if I use Cells().
Any help much appreciated.
Just do:
sheetMaster.Cells(targetRow, targetColumn).PasteSpecial xlPasteValues
An error could occur with this, if the sheetMaster isn't the ActiveSheet at runtime:
Range(sheetMaster.Cells(targetRow, targetColumn).PasteSpecial) xlPasteValues
Also note, for this problem:
Unfortunately, I want only the values; bringing over formulas and formatting will screw up other behavior in the sheet.
You can get the range's .Value as an array, and write it directly to the other sheet without invoking either Copy or Paste/PasteSpecial methods. The answer below shows several methods of copying/pasting from one workbook to another, but could easily be modified for sheet-to-sheet transfer, instead.
Copy from one workbook and paste into another
Related
I inherited a report that acts as a master tracker for changes made in several other reports. The previous owner was using VLOOKUP formulas to pull data, however I decided to try my hand at a VBA macro and was able to patchwork something together (see below) despite being new to this. It works fine, however:
Problem 1: Right now, the macro returns values one column at a time. I have four nearly identical sub procedures that run back-to-back, one per column: Updated_LName (N), New_Doc (O), New_ID (P), Comments (Q).
Desired Solution: I'd like to increase efficiency by searching for the Student_ID_Nbr (K) in the previous worksheet and then returning values for all four columns at once: Updated_LName, New_Doc, New_ID, Comments (N:Q).
Problem 2: I couldn't figure out a better way than clearing formatting to skip to the next Student_ID_Nbr if it's not found on the previous page. I don't want to overwrite any existing values, which is why I didn't assign an empty string value in the If/Else statement.
Desired Solution: Find a better way to skip to the next iteration if Student_ID_Nbr is not found in the previous worksheet without overwriting existing data.
Problem 3: The macro currently ignores records where there is no Student_ID_Nbr match between the master and the previous worksheet. All changes must be extracted from the other reports and reflected in the master worksheet.
Desired Solution: I'd like to paste in the entire row (A:Q) for each record where the Updated_LName (N), New_Doc (O), New_ID (P), AND/OR Comments (Q) are not blank, AND the Student_ID_Nbr is not present in the master worksheet.
Note: Assume Student_ID_Nbr is a primary key.
Screenshot of example worksheets/data, after running macro successfully
K
L
M
N
O
P
Q
1
Imported
Imported
Imported
Imported
2
Student_ID_Nbr
Qty
LName
Updated_LName
New_Doc
New_ID
Comments
3
123456789
1
Doe
Smith
Transcript
987654321
Marriage cert submitted
Public Sub PullUpdated_LName()
'Declarations
Dim varID As Variant
Dim wsCurrent As Worksheet
Dim wsPrevious As Worksheet
Dim rngSelection As Range
Dim i As Integer
For i = 3 To 30000
'Initialization
Set wsCurrent = ActiveSheet
Set wsPrevious = wsCurrent.Previous
Set rngSelection = ActiveCell
'Error checking--do nothing if not in the correct column
If Not rngSelection.Column = 14 Then
MsgBox "Please select a cell in column N.", vbCritical + vbOKOnly, "Error"
Exit Sub
End If
'Search for ID on the previous ws
Set varID = wsPrevious.Columns(11).Find(What:=wsCurrent.Cells(rngSelection.Row, 11).Value)
'If ID not found, leave existing values alone (including empty cells) on current sheet
If varID Is Nothing Then
rngSelection.ClearFormats
Else
'Return the value in the appropriate row and column from the previous sheet
rngSelection.Value = wsPrevious.Cells(varID.Row, 14).Value
End If
'Regardless, move to the next cell
wsCurrent.Cells(rngSelection.Row + 1, rngSelection.Column).Select
Next i
'Move to next column (to prepare for the next sub)
wsCurrent.Cells(3, rngSelection.Column + 1).Select
'Run next sub automatically
PullNew_Doc
End Sub
Thank you to ShawnPCooke for the great starting point.
You seem to be re-initializing the worksheets each time around the loop, and the limit of 30000 rows to search seems arbitrary and will likely be slow while that searches empty space. Any time you "Select" a cell, you will potentially have the view updating; best to keep everything in Range variables.
This code probably addresses your first two points:
Public Sub Pull_All()
'Declarations
Dim varID As Variant
Dim wsCurrent As Worksheet
Dim wsPrevious As Worksheet
Dim rngSelection As Range
Dim i As Integer
Dim search_zone As Range
Dim last_row As Long
Dim update_cols As Variant
Dim ref_row As Long
Dim ref_col As Long
Dim col As Variant
update_cols = Array(14, 15, 16, 17)
ref_row = 3
ref_col = 11
'Initialize sheets
Set wsCurrent = ActiveSheet
Set wsPrevious = wsCurrent.Previous
Set search_zone = wsPrevious.Columns(11)
' start on a defined cell in the worksheet; this may need update
Set rngSelection = wsCurrent.Cells(ref_row, ref_col)
last_row = rngSelection.SpecialCells(xlCellTypeLastCell).Row
For i = ref_row To last_row
' Search for ID on the previous ws
Set varID = search_zone.Find(What:=rngSelection.Value)
If Not varID Is Nothing Then
' Return the values in the appropriate row and update columns from the previous sheet
For Each col In update_cols
rngSelection.Offset(0, col - ref_col).Value = wsPrevious.Cells(varID.Row, col).Value
Next col
End If
' move to the next cell
Set rngSelection = rngSelection.Offset(1, 0)
Next i
End Sub
Background: I have a table in excel that data will get added to over time, and to give my coworkers (who, while lovely, do not like tinkering with things in excel in fear of messing something up) an easy option for expanding the table if it fills when I'm not around, I wanted to add a macro button to add more lines to the table and fill in the formatting (some cells have IF functions in & most have conditional formatting). The idea is they can fill up to but not including the last line of the table, then hit the button and it will add 20 or so new lines before the last line of table and copy the formatting of the last line into them.
So far this is my code:
Sub Add_Rows()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim tbl As ListObject
Set tbl = ws.ListObjects("Table1")
x = tbl.Range.Rows.Count
Range(x - 1, x + 19).Insert Shift:=xlShiftDown, CopyOrigin:=xlFormatFromRightOrBelow
End Sub
I am getting a "Run time error '1004'" "Method range of object _global failed" message when I try clicking the button, and it highlights the "insert" line as being the issue. I am new to vba so any advice is welcome. If my code is utter nonsense then an alternative direction would be appreciated.
Also this is the second version, my first looped Rows.Add which worked, but was taking a few seconds so my hope was inserting 20 would be faster than adding 1 20 times!
Try this.
Sub Add_Rows()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim tbl As ListObject
Dim lastRow As Range, newRng As Range
Dim newRows As Integer: newRows = 20
Set tbl = ws.ListObjects("Table1")
' Last row
On Error GoTo resizeOnly ' Listrows = 0
Set lastRow = tbl.ListRows(tbl.ListRows.Count).Range
On Error GoTo 0
' range of new rows
Set newRng = tbl.ListRows(tbl.ListRows.Count).Range.Resize(newRows).Offset(1)
' resize table
tbl.Resize tbl.Range.Resize(tbl.Range.Rows.Count + newRows, tbl.Range.Columns.Count)
' copy last format to new rows
lastRow.Copy
newRng.PasteSpecial xlPasteFormulasAndNumberFormats
Application.CutCopyMode = False
Exit Sub
resizeOnly:
' resize table
tbl.Resize tbl.Range.Resize(tbl.Range.Rows.Count + newRows, tbl.Range.Columns.Count)
End Sub
If you have no data below the table, you can just assign values to the rows immediately after the table. The table will automatically expand to encompass the new rows, as long as at least one cell in each row, has well defined data.
' Insert 3 new rows into the listoject
' We assume the ListObject already contains data
Public Sub Test(Lob As ListObject)
Dim Sht As Worksheet
Dim StartRow As Long, StartCol As Long, NumCols As Long
Dim Lst As Variant
Dim Rng As Range
' Allocate 3 new rows
NumCols = Lob.ListColumns.Count
ReDim Lst(1 to 3, 1 to NumCols)
' Get the first column of and the first row following the list table
StartCol = Lob.Range.Column
StartRow = Lob.Range.row + Lob.Range.Rows.Count
' Create a range big enough to hold the data, immediately under the last row of the table.
Set Sht = Lob.Parent
Set Rng = Sht.Cells(StartRow, StartCol).Resize(UBound(Lst), UBound(Lst, 2))
' Add some data to the new rows
Lst(1, 1) = "Test1"
Lst(2, 1) = "Test2"
Lst(3, 1) = "Test3"
' Copy data to the destination
Rng = Lst
End Sub
If the list object does not contain data, ie Lob.ListRows.Count = 0, then write data after the header otherwise write it after the last rows.
There are some mistakes in your code:
"Range(x , y)" will cause an error, when x and y are integers. If you want to refer to a cell. Try Cells(x, y). Or Range(Cells(x1, y1), Cells(x2, y2)) to refer to more cells.
And Resize() takes two arguments, and returns a range - it does not affect anything on the sheet.
See also how to insert rows if you want:
Excel Range.Insert:
Example from the doc:
With Range("B2:E5")
.Insert xlShiftDown
' Optionally clear formats, which you do not want, if you add to
' a table with well defined data and formats.
.ClearFormats
End With
The number of the rows inserted, will equal the number of rows in the range we call Insert on.
I have some VBA code that queries and creates a table of data in a worksheet with comments in some of the cells.
It's occupies a range of about A1:N200 and then I want to hide the unused space like in the code below.
Worksheet.Columns(Number_of_columns + 1).Resize(, Worksheet.Columns.Count - Number_of_columns).EntireColumn.Hidden = True
Worksheet.Rows(Number_of_rows & ":" & Worksheet.Rows.Count).EntireRow.Hidden = True
Doing so throws the run-time error 1004:
Unable to set the hidden property of the range class
I have checked in a new Excel file, added a comment to the cell A1 and then tried hidding the other columns and rows but had to leave 4 columns (A to D, but could have been for example A and C to E) and 5 rows visible. If I try hidding more I get the message Cannot shift objects off sheet.
Below is an example of a procedure that throws errors when ran in a new Excel file.
Private Sub Procedure()
Dim Worksheet As Excel.Worksheet
Dim Range As Excel.Range
Set Worksheet = Excel.Application.ThisWorkbook.ActiveSheet
Set Range = Worksheet.Cells(1, 1)
If Range.Comment Is Nothing Then
Range.AddComment
End If
Set Range = Worksheet.Columns(2).Resize(, Worksheet.Columns.Count - 1).EntireColumn
Range.Select ' Just to test the range, it works. Columns B to XFD
Range.Hidden = True ' Throws error
Set Range = Worksheet.Rows(2 & ":" & Worksheet.Rows.Count).EntireRow
Range.Select ' Just to test the range, it works. Rows 2 to 1048576
Range.Hidden = True ' Throws error
End Sub
Is there any way to hide them so that only the data is visible? The only workaround (not solution) that I can think of is removing the comments, hidding the columns and rows, and then adding the comments back, which is undesirable.
I am not sure if I understand correctly, would be easier to see Excel, below is the sample code, just tested on Excel 2016:
Sub StackOverflow()
Dim lngLastRow As Long
Dim lngLastColumn As Long
Dim lngLastColLetter As String
Dim shtWorking As Object
Set shtWorking = ActiveSheet
'find last row
lngLastRow = shtWorking.Cells(shtWorking.Rows.Count, 1).End(-4162).Row + 1
'find last column
lngLastColumn = shtWorking.Cells(1, shtWorking.Columns.Count).End(-4159).Column + 1
'convert last column index to last column letter
lngLastColLetter = Split(shtWorking.Cells(1, lngLastColumn).Address, "$")(1)
'hide columns
shtWorking.Columns(lngLastColLetter & ":XFD").EntireColumn.Hidden = True
'hide rows
shtWorking.Rows(lngLastRow & ":" & shtWorking.Rows.Count).EntireRow.Hidden = True
set shtWorking=nothing
End Sub
I'm trying to make a macro in Excel VBA 2007 that searches through the selected field and if it finds a certain string anywhere in a row, it copies and pastes that row into another sheet.
However, I'm getting a compile error: object required right on the sub level (line 1). My code so far is below.
Sub SearchCopyPaste()
'
' SearchCopyPaste Macro
' Searches for a string. If it finds that string in the line of a document then it copies and pastes it into a new worksheet.
'
' Keyboard Shortcut: Ctrl+Shift+W
'
Dim sourceSheet, destinationSheet As Worksheet
Set sourceSheet = Worksheets(1) 'Define worksheets
Set destinationSheet = Worksheets(2)
Dim selectedRange As Range 'Define source range
Set selectedRange = Selection
Dim numRows, numColumns As Integer 'Determine how many rows and columns are to be searched
Set numRows = Range(selectedRange).Rows.Count
Set numColumns = Range(selectedRange).Columns.Count
Set destinationRowCount = 1 'Counter to see how many lines have been copied already
'Used to not overwrite, can be modified to add header,etc
Dim searchString As String 'String that will be searched. Will eventually be inputted
Set searchString = "bccs" 'Will eventually be put into msgbox
For rowNumber = 1 To numRows
If InStr(1, selectedRange.Cells(i, numColumns), searchString) > 0 Then
selectedRange.Cells(rowNumber, numColumns).Copy Destination:=destinationSheet.Range(Cells(destinationRowCount, numColumns))
destinationRowCount = destinationRowCount + 1
Next rowNumber
End Sub
You are using the Set keyword wrong. In your code above you only need to use it to assign Worksheet and Range objects, not for integers and strings. Remove the Set keyword on those lines.
Also, you're missing an End If in your For loop.
I have a rather silly problem. I have a macro (linked to a button) which copies cells A1:A2 from one worksheet (namedFP) to another worksheet (Log). I intend to copy these 2 cells on the log sheet every time I hit the macro button. The problem I am facing right now is that when I use the button multiple times, these cells are getting copied over each other instead of using the next available row to paste the cells.
This is what I have now, and I tried changing the 'Rowcount+1' to 'RowCount+2' but that did not work. Any help is appreciated.
DHRSheet.Select
Range("A1:A2").Select
Selection.Copy
LogSheet.Select
RowCount = LogSheet.UsedRange.Rows.Count
Dim r As Integer
r = RowCount + 1
Dim infocell As Range
Set infocell = Cells(r, 1)
infocell.Select
ActiveSheet.Paste
infocell.Value = DHRSheet.Name & "$" & infocell.Value
DHRSheet.Select
ActiveWorkbook.Save
Is this what you are trying?
Sub Sample()
Dim LogSheet As Worksheet, DHRSheet As Worksheet
Dim lrow As Long
'~~> Change this as applicable
Set LogSheet = Sheets("Sheet1")
Set DHRSheet = Sheets("Sheet2")
With LogSheet
lrow = LogSheet.Range("A" & .Rows.Count).End(xlUp).Row + 1
DHRSheet.Range("A1:A2").Copy .Range("A" & lrow)
End With
End Sub
Here's a function I use that is very reliable and always returns the last row of a sheet without fail:
(possibly excessive for your simple use, but I always recommend it)
Public Function LastRowOfSheet(ByVal TestSheetNumber As Variant)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Input: Sheet index # or Sheet name
' Output: Last row of sheet.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim intNumberOfRowsInWorksheet As Long
intNumberOfRowsInWorksheet = Sheets(TestSheetNumber).UsedRange.Rows.Count
intNumberOfRowsInWorksheet = intNumberOfRowsInWorksheet + Sheets(TestSheetNumber).UsedRange.Row - 1
LastRowOfSheet = intNumberOfRowsInWorksheet
End Function
And I'd clean up your above code and use something like this:
Sub Move2RowsToEnd()
Dim iNextRowOfOutput As Long
Dim iRowNumber As Long
'- use the function to find the last row of the output sheet. we'll be pasting to the first row after.
iNextRowOfOutput = (LastRowOfSheet("Log") + 1)
'- you can adjust this for loop to loop through additional cells if you need to paste more than 2 rows in the future.
For iRowNumber = 1 To 2
'- for each row of input (2 total) set the value of the output sheet equal to it.
Sheets("Log").Range("A" & iNextRowOfOutput).Value = Sheets("namedFP").Range("A" & iRowNumber).Value
iNextRowOfOutput = iNextRowOfOutput + 1
Next iRowNumber
'- not sure which of these you want to save (one or both)
Sheets("namedFP").Save
Sheets("Log").Save
End Sub
Just paste the function above or below the Subroutine and let me know if you have any issues or questions regarding the 'Move2RowsToEnd' code.