I have written this code, that is part of a bigger problem. Initially it was supposed to start transfer some data from a worksheet to another.. but it keeps skipping rows, it copies one, skips then copies the other one, skips ,copies,skip... I am using the Select method just to test, instead of copy.
Dim sharepointSheet As Worksheet
Dim masterSheet As Worksheet
Dim sharepointTable As Range
'Auxliary variable
Dim row As Range
Dim cell As Range
Dim RowLast As Long
Set sharepointSheet = ThisWorkbook.Worksheets("Sharepoint List")
Set masterSheet = ThisWorkbook.Worksheets("Master List")
Set sharepointTable = masterSheet.Range("A2", "F133")
For Each row In sharepointTable.Rows
row.Cells(row.row, 3).Select
' RowLast = masterSheet.Cells(Rows.Count, "A").End(xlUp).row + 1
' masterSheet.Cells(RowLast, "A").PasteSpecial
Next row
You are having the problem because you are selecting the row relative to you row range rather than the worksheet range.
If you change the select line to the following it will solve your problem:
masterSheet.Cells(row.row, 3).Select
Also not that it's not a good idea to use variables such as row for a range because it can get very confusing!
Related
What I am trying to do is, in each worksheet:
1. Copy all numbers in column G (G23 and down) and paste special at the end of column A.
2. Format the pasted numbers to have only one decimal point.
3. Copy the pasted numbers and paste them at the end of column B, and remove duplicates.
I finished Step 1, but I don't know how to do Step 2 and 3.... I could not find ways to select the just pasted numbers at the bottom of Column A. I am new to VBA - Many thanks for your help.
Here is the code I have so far:
Sub WorksheetLoop()
Dim WS_Count As Integer
Dim I As Integer
Dim rng As Range
Dim last As Long
'Set WS_Count equal to the number of worksheets in the active workbook.
WS_Count = ActiveWorkbook.Worksheets.Count
'Begin loop, starts from the sixth worksheet
For I = 6 To WS_Count
last = Worksheets(I).Cells(Rows.Count, "G").End(xlUp).Row
Set rng = Worksheets(I).Range("G23:G" & last)
Worksheets(I).Select
rng.Copy
Worksheets(I).Cells(Rows.Count, 1).End(xlUp)(2).PasteSpecial xlPasteFormulasAndNumberFormats
....(what should I do next here?)
Next I
Application.ScreenUpdating = True
End Sub
You already know the range of the values to be pasted. The first cell of that range is the one used for PasteSpecial and the number of rows will be equal to the number of rows in rng. The required information is already there, all that is needed is to set it to a variable.
Here's a snippet to illustrate:
Sub Example()
Dim last As Long
Dim copyRange As Range
Dim pasteRange As Range
last = Worksheets(1).Cells(Rows.Count, "G").End(xlUp).Row
Set copyRange = Worksheets(1).Range("G23:G" & last)
Set pasteRange = Worksheets(1).Cells(Rows.Count, 1).End(xlUp)(2) _
.Resize(copyRange.Cells.Count, 1)
copyRange.Copy
pasteRange.PasteSpecial xlPasteFormulasAndNumberFormats
' use pasteRange for modifying the pasted data
End Sub
Changing the format can be done with range.NumberFormat. In this case you could do:
pasteRange.NumberFormat = "0.0"
I find it rather strange that you first copy the NumberFormat and then change it, though! Maybe you could choose to format the entire column A and not paste the formatting?
range.RemoveDuplicates is built in Excel for the third step. Here are a couple of answers that showcase how it can be used:
Remove Duplicates from range of cells in excel vba
Delete all duplicate rows Excel vba
I would like to create a function that copies certain excel ranges in worksheets and paste these ranges into a "motherfile".
Now, I am trying with this code:
Sub ranges()
Dim month As Variant
Dim months As Variant
months = Array("V01 DEN HAAG", "V02 AMSTERDAM")
Dim destinationRange As Excel.range
Set destinationRange = Sheets("DATASET").range("B3").End(xlDown).Offset(1, 0)
For Each month In months
Dim sourceRange As Excel.range
Set sourceRange = Sheets(month).range("H7", range("H7").End(xlToRight))
Call sourceRange.Copy
Call destinationRange.PasteSpecial
Next month
End Sub
But, I get an Application-defined or object-defined error. Any thoughts on what goes wrong? Thanks!
Adding to mielk's anwser the problem is in the codeline:
Set sourceRange = Sheets(month).range("H7", range("H7").End(xlToRight))
This is because if you are collecting from multiple sheets data and you use range("H7").End(xlToRight it will search for this on the active sheet. Therefor it can only find the correct range if its on the correct sheet.
by using the following code:
Set sourceRange = Sheets(month).Range("H7", Sheets(month).Range("H7").End(xlToRight))
it will work no matter which sheet is active at that moment.
another addition is you can copy and paste in 1 code line:
sourceRange.Copy Destination:=destinationRange
see below the entire code:
Sub ranges()
Dim month As Variant
Dim months As Variant
months = Array("V01 DEN HAAG", "V02 AMSTERDAM")
For Each month In months
Dim sourceRange As Excel.Range
Dim destinationRange As Excel.Range
With Sheets("DATASET")
Set destinationRange = .Cells(.Rows.Count, 2).End(xlUp).Offset(1, 0)
End With
Set sourceRange = Sheets(month).Range("H7", Sheets(month).Range("H7").End(xlToRight))
sourceRange.Copy Destination:=destinationRange
Next month
End Sub
The possibly reason for this error is that you don't have any values in worksheet "DATASET", column B, below 3. row.
Look at this line of code:
Set destinationRange = Sheets("DATASET").range("B3").End(xlDown).Offset(1, 0)
First it takes the range from cell B3 to the last cell in this column (B1048576 in Excel 2007+).
After that it tries to offset this range by one row down (so it tries to create a range having the same number of rows and columns but starting one cell below).
However, it is not possible, because such range would have to start in cell B4 and end in cell B1048577 and Excel has only 1048576 rows.
If you want to assign the first empty row to the variable destinationRange you should replace this code:
Set destinationRange = Sheets("DATASET").range("B3").End(xlDown).Offset(1, 0)
with the below:
With Sheets("DATASET")
Set destinationRange = .Cells(.Rows.Count, 2).End(xlUp).Offset(1, 0)
End With
Both those statements are similar. The difference is that the second one
starts from the last cell in the column B and look for the first non-empty
cell above.
I basically need to copy rows from one sheet to another. The rows which I need to copy are on sheet 2 , columns A to N and I need to copy the rows that has the unique value in column N.
Column N will just be =M1 or =M2 depending on which row has data on it.
Hence I will use a worksheet calculate event to try capture this.
The tricky part is that each time new values exist in say the last row on sheet 2 and then N gets filled form M. I don't want the previously copied rows to be copied. It may also be the case that the entire contents of the rows change places or that one of the rows disappears and the other row will fill its gap on sheet 2. So I need to avoid the calculate event recognizing this from the =M line. i.e if it has already been copied but gets recalcuated - -I don't need it to be copied again.
I guess one way to do this would be toi lookup if the N column value exists in the N column value on sheet 1. Because if that row disappears then it will be on the sheet 1. it will because I have other formulas putting it there.
My starting point for dong this is the code below and I have this set in the worksheet code of sheet 1
Private Sub Worksheet_Calculate()
Dim i As Long
Dim lr1 As Long, lr2 As Long
Dim Delta As String
Dim wks1 As Worksheet, wks2 As Worksheet
Set wks1 = ActiveSheet
Set wks2 = Worksheets("Sheet2") 'change to suit
lr1 = wks1.Cells(Rows.Count, "N").End(xlUp).Row
For i = 2 To lr1
lr2 = wks2.Cells(Rows.Count, "A").End(xlUp).Row + 1
wks1.Cells(i, "N").EntireRow.Copy Destination:=wks2.Cells(lr2, "A")
Next i
End Sub
I also have this working which I would need to incorporate into that worksheet calcualte
Sub updt()
Dim sh1 As Worksheet, sh2 As Worksheet, lr As Long, rng As Range
Set sh1 = Sheets(1) 'Edit sheet name
Set sh2 = Sheets(2) 'Edit sheet name
lr = sh1.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh1.Range("A2:A" & lr)
For Each c In rng
If WorksheetFunction.CountIf(sh2.Range("A:A"), c.Value) = 0 Then
sh2.Range("A" & sh2.Cells(Rows.Count, 1).End(xlUp).Row)(2) = c.Value
End If
Next
End Sub
The fastest method is pretty sure to copy all wanted rows an then call the remove dublicates function which is almost instantanios. You can simply set your unique col as indicator
I have cobbled together a subroutine to get two ranges of data from blocks of cells in two separate worksheets. Then, using the .Copy method, it puts the first block into (1, 1) of a third worksheet and the second block into the next available row of that worksheet.
The code I have written pretty much does what I want it to do, except that for some reason it will not paste the second range (declared as DataRng2 below) unless the sub is run twice in a row. Here is what I have:
Sub Test()
Dim DataRng As Range
Dim DataRng2 As Range
Dim Test As Worksheet
Dim EmtyRow As Range
Application.ScreenUpdating = False
Set Test = Worksheets("Test")
'Set the "EmptyRow" reference to whatever the next empty row is in the destination worksheet - checks column A
Set EmptyRow = Worksheets("Test").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
'Select all utilized cells in 82-Medicine tab and copy them
Worksheets("82-Medicine").Select
Set DataRng = Worksheets("82-Medicine").Cells(2, 1).CurrentRegion
'Select the destination worksheet and paste copied cells to A1
Test.Select
DataRng.Copy Cells(1, 1)
'Select all utilized cells in Fee Basis tab and copy them
Worksheets("Fee Basis").Select
Set DataRng2 = Worksheets("Fee Basis").Cells(2, 1).CurrentRegion
'Select the destination worksheet and paste copied cells to the next empty row
Test.Select
DataRng2.Copy EmptyRow
Application.ScreenUpdating = True
End Sub
Why do I have to run it twice to get it to work? Is there a way to fix that?
I should note that I am using the .CurrentRegion property to get the data only because rows of data will frequently be added to and subtracted from the ranges of cells I need to grab, and .CurrentRegion is the simplest way I know to grab the first range of whatever cells are occupied. I am open to using a different property or method if necessary.
Option Explicit
Sub Test()
Dim src_1 As Worksheet
Dim src_2 As Worksheet
Dim dest As Worksheet
Dim src_1_rng As Range
Dim src_2_rng As Range
Dim lr As Integer
Dim lc As Integer
Set src_1 = ThisWorkbook.Sheets("82-Medicine")
Set src_2 = ThisWorkbook.Sheets("FeeBasis")
Set dest = ThisWorkbook.Sheets("Test")
'' Set up range for data from '82-Medicine'
lr = src_1.Cells(2, 1).End(xlDown).Row
lc = src_1.Cells(2, 1).End(xlToRight).Column
Set src_1_rng = src_1.Range(src_1.Cells(2, 1), src_1.Cells(lr, lc))
'' Set up range for data from 'FeeBasis'
lr = src_2.Cells(2, 1).End(xlDown).Row
lc = src_2.Cells(2, 1).End(xlToRight).Column
Set src_2_rng = src_2.Range(src_2.Cells(2, 1), src_2.Cells(lr, lc))
'' Copy the data to the destination sheet ('Test')
src_1_rng.Copy dest.Range("A" & dest.Rows.Count).End(xlUp).Offset(1)
src_2_rng.Copy dest.Range("A" & dest.Rows.Count).End(xlUp).Offset(1)
End Sub
Not sure why that wouldn't work but try this. I've never been a fan of CurrentRegion or selecting different sheets during code. Why bother when you can just use references? This should work perfectly.
edit
Changed the lr and lc variables to use xlDown from (2,1) and xlToRight from (2,1) to properly get a "CurrentRegion"-esque range.
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 the error in the title on the row noted below. What would be causing this?
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
numRows = Range(selectedRange).Rows.Count '<<<<<<<< Error
numColumns = Range(selectedRange).Columns.Count
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
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
End If
Next rowNumber
End Sub
Try:
numRows = selectedRange.Rows.Count '<<<<<<<< Error
numColumns = selectedRange.Columns.Count
There may be other errors, I have not tested your full code, but this should fix the immediate error you're experiencing.
Some tips:
Declare all of your variables at the top of your sub
Add a new line for each variable to make your code more readable
Anytime you are using a variable to store row numbers declare it as Long
If you know the range you want to work with beforehand define it as a range in your code
This code should do something close to what you want. Give it a try and let me know.
If you know the range you would like to use before running the macro instead of using "Selection" I suggest specifying the exact range or "Sheets(1).UsedRange" for the entire first sheet.
Sub SearchCopyPaste()
Dim fnd As String
Dim vCell As Range
Dim rng As Range
Dim totalCols As Integer
Dim rowCounter As Long
'Set this to a specific range if possible
Set rng = Selection
totalCols = rng.Columns.Count
'Get the data to find from the user
fnd = InputBox("Input data to find")
'Loop through all cells in the selected range
For Each vCell In rng
'If the data is found copy the data and paste it to Sheet2, move down one row each time
If InStr(vCell.Value, fnd) > 0 Then
rowCounter = rowCounter + 1
Range(Cells(vCell.row, 1), Cells(vCell.row, totalCols)).Copy Destination:=Sheets(2).Cells(rowCounter, 1)
End If
Next
'Copy the column headers onto the second sheet
Sheets(2).Rows(1).EntireRow.Insert
rng.Range(Cells(1, 1), Cells(1, totalCols)).Copy Destination:=Sheets(2).Cells(1, 1)
End Sub