Copying Row Except Last Column in VBA - vba

I am writing an Excel VBA macro and one of the tasks is to copy a subset of the data from a sheet to another.
I currently use the below, which copies the whole row fine (C is a row index):
Dim ConsolidatedRow As Excel.Range
Set ConsolidatedRow = ConsolidatedSheet.Range("A" & C).EntireRow
...
ConsolidatedRow.Copy Destination:=ResultSheet.Range("A" & ResultRowIndex)
I want to copy ConsolidatedRow, but without the last column. This last column is used in other operations between declaration and copy so the ideal solution would be a change to the copy statement. I've tried offsets, updating the range in ConsolidatedRow and loads of other things but no luck.

I prefer to use the Range.End property to locate the last used cell. Helps out if your row doesn't extend out as far as others in your sheet. Replace the Set ConsolidatedRow command with the following:
With ConsolidatedSheet
CopyExtent = .Range("A" & C).End(xlToRight).Column - 1
Set ConsolidatedRow = .Range(.Cells(C, 1), .Cells(C, CopyExtent))
End With
This assumes you have no gaps in your data. If you have blank cells that you want included in the copied section, change to this:
CopyExtent = ConsolidatedSheet.Cells(C, .Columns.Count).End(xlToLeft).Column - 1
Hope this helps!

Assuming that you don't use columns behind this consolidatedRow in this worksheet, add two lines after set
Set ConsolidatedRow = Intersect(ConsolidatedSheet.UsedRange, ConsolidatedRow)
Set ConsolidatedRow = ConsolidatedRow.Resize(1, ConsolidatedRow.Columns.Count - 1)

Related

Excel VBA: How do I assign a range to a variable?

The current code is as follows:
With Sheets(sheetChk)
a = .Range(chkCell, .Range(Left(chkCell, 1) & Rows.Count).End(xlUp)).Value
End With
sheetChk is defined as the desired sheet index.
chkCell is defined as the desired "first cell" in the range.
I am attempting to assign a range to a. The problem is that the above code grabs the last cell in the column, entirely. Rather, I want to end at a specific row as I have other data in the same column after the desired range that needs to be ignored. How can I accomplish this?
First to assign a range, you need to have a Set first.
Example: Set a = Range("A1")
Another problem I see is that you're putting a .value at the end. That doesn't make sense for a range.
If you want to specify a specific row, then you need to include that in the code instead of using end(xlUp).
Example if it's row 50:
With Sheets(sheetChk)
Set a = .Range(chkCell, .Range(Left(chkCell, 1) & 50).End(xlUp))
End With
What you're currently using is finding the bottom row being used, which doesn't sound like you want. If you want to go the other direction (i.e. from the starting cell down until there's an empty cell), you can use this code:
With Sheets(sheetChk)
Set a = .Range(chkCell, .Range(Left(chkCell, 1) & chkCell.Row).End(xlDown))
End With
Based on your code, it looks like you might be putting an address in whatever cell chkCell is. If you have the row in that cell, and assuming you never exceed column z, then you could use this code to find the row:
With Sheets(sheetChk)
Set a = .Range(chkCell, .Range(Left(chkCell, 1) & Right(chkCell,Len(chkCell)-1))
End With
If that doesn't work, you need to figure out some method determine what row to use. Hope that helps.
dim rng as range
set rng = thisworkbook.sheets("sheet1").range("a1:a666")

Copying one sheet to another workbook based on one criteria

I have 2 different workbooks, main and copy.
Row 1 is meant for header/labeling the information it will be providing for both workbooks.
The "main" workbook will be using columns A to N. The copy will be using columns A to M.
The criteria to determine whether the code will be copying is the workbook, "main", column M.
If the cell contains "X" - it will copy column A to L, and N, to the workbook "copy". After which, it will go on to the next row to determine the same thing.
If the cell is empty, it will proceed down to the next row to determine the same thing as well.
The code has to be dynamic as new information will be added every 3 months, such as new rows added or the criteria changing from "X" to empty, or empty to "X".
I am a beginner in VBA excel, and have been trying out multiple codes but it doesn't seems to work. Would greatly appreciate it if someone could help me out with this.
Showing your code so far will help us a lot.
Maybe this helps a little:
Dim wks As Worksheet
Dim wks_copy As Worksheet
Set wks = Worksheets("main")
Set wks_copy = Worksheets("copy")
j = 2
For i = 2 To wks.UsedRange.Rows.Count
If wks.Cells(i, 13).Value = "x" Then
wks.Range(Cells(i, 1), Cells(i, 14)).Copy Destination:=wks_copy.Cells(j, 1)
j = j + 1
End If
Next i
This will copy the entire row. If you don't want to copy column M, I suggest clearing or hiding the column after copying.
If the macro runs again after 3 months, it will overwrite the existing data on Worksheet copy. But you should delete the worksheet's values before that, for example by using
Worksheets("copy").UsedRange.Offset(1, 0).ClearContents
or manually clearing the range.

Copy rows based on cell value and paste on a new sheet

Check This
I need a help. I want to copy whole cell from A sheet name "Components" only if value in Column C is > 0 to a new Sheet name "Load list"
Can someone please give me the macro code for this?
on your new sheet you can add this condition the cell or range of cells:
=IF(Components!C5>0,Components!A5)
where C5 has thevalue to compare, and A5 has the value copy if the condition happens.
Right in my swing!
The formula given by #sweetkaos will work fine, in case you want to replicate the data as it is with blanks where data is not found.
I will imagine a slightly more complicated situation. I am assuming you want just one line in the next format as is shown in your image.
Also conveniently assuming the following:
a. both sheets have fixed start points for the lists
b. 2 column lists - to be copied and pasted, with second column having value
c. Continuous, without break source list
d. basic knowledge of vba, so you can restructure the code
Here is the code. Do try to understand it line by line. Happy Excelling!
Sub populateLoadList()
'declaring range type variables
Dim rngStartFirstList As Range, rngStartLoadList As Range
'setting values to the range variables
'you must change the names of the sheets and A1 to the correct starts of your two lists
Set rngStartFirstList = Worksheets("Name_of_your_fist_sheet").Range("A1")
Set rngStartLoadList = Worksheets("Name_of_your_second_sheet").Range("A1")
Do While rngStartFirstList.Value <> ""
If rngStartFirstList.Offset(1, 0).Value < 0 Then
Range(rngStartFirstList, rngStartFirstList.Offset(0, 1)).Copy
rngStartLoadList.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Set rngStartLoadList = rngStartLoadList.Offset(1, 0)
End If
Set rngStartFirstList = rngStartFirstList.Offset(1, 0)
Loop
End Sub
Basically what i want is ... if Value on C is >0 i want whole column 10 copied to that new sheet .... not only that cell

excel VBA code to Copy and Paste a set of data with a finite amount (count)

In excel on a single sheet, I have a blank template and a set of raw data on the side which needs to be inserted into the template. I need help creating the VBA code to copy and paste the data into the template with it not pasting any extra cells (stop at the end of the data). My raw data changes and should be able to be any length of rows but it is always constant from columns Z:AL. I am interesting in moving it to columns A5:M5.
Thanks in advance!
This is the simplest code I can think of. You might want to throw a worksheet reference in front of the Range and I included a couple of methods of finding the end of the range. I prefer the 3rd method.
dest = "A5"
wsName = "DataSheet"
With Worksheets(wsName)
endRow1 = .Range("Z1").End(xlDown).Row
endRow2 = .Range("Z105000").End(xlUp).Row
endRow3 = .Range("Z:AL").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
.Range("Z1:AL" & endRow3).Copy Destination:=Range(dest)
End With
If there are not blanks in a column in the dataset (I assume column Z) then you can use Range.End to get the last row. I try to avoid using Copy/Paste in macros, because there's a faster way to do it.
Option Explicit
Sub MoveDataRange()
Dim dest As Range, endRow As Integer
With Worksheets("DataSheet")
endRow = .Range("Z1").End(xlDown).Row
Set dest = .Range("A5").Resize(endRow, 13) '13 columns between Z:AL
dest.Value = .Range("Z1:AL" & endRow).Value
End With
End Sub

Copy consolidated row data from multiple worksheets where a specific column is populated

I'm looking to copy a range of data from multiple worksheets to a single Summary sheet based upon a specific column being populated.
I'm using the code found on the link :
https://msdn.microsoft.com/en-us/library/cc793964(v=office.12).aspx
under the section entitled 'Copying All Data Except Column Headers from Multiple Worksheets'
It works although I've been trying to modify the code so that instead of copying the whole sheet, it copies only rows in which column 'N' is populated.
I disabled the line of code that sets CopyRng to the whole sheet and introduced a For loop to check the N column - I got the program to return any values which were present inside Column N across all the sheets but I need to return the entire rows of these instances.
Here is my modified code for the section in question :
' If source worksheet is not empty and if the last
' row >= StartRow, copy the range.
If shLast > 0 And shLast >= StartRow Then
'Set the range that you want to copy
'Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))
For Each cell In sh.Range("N4:N4")
If (cell.Value <> "") Then
Set CopyRng = '(trying to copy the entire row here..)
End If
Next
Could anyone help in regard to how I would go about setting CopyRng return the entire row?
thanks
Use
Set CopyRng = cell.EntireRow
That should select the whole row for you to copy. However I'd be slightly timid about using it if you're doing a lot of copy and pasting as it selects many cells that you won't need. If you know the maximum extent of your data in columns then it might be better to use
Set CopyRng = Worksheets(SHEET_YOU_WANT).Range("A" & cell.row & ":" & furthestColumn & cell.row)
As this will take less time to complete.