VBA - Copy, Paste then move to next row until reaching blanks - excel

Essentially, I have data in three columns and a model on a separate tab. The data tab has 1,000 rows of data, and each entry will be run through the model, with results being pasted into the fourth column.
Here's what one iteration would look like, but I need it to loop through every row.
Worksheets("Data").Range("E2:G2").Copy _
Worksheets("Model").Range("B4:D4").PasteSpecial Paste:=xlPasteValues
Calculate
Worksheets("Model").Range("C120").Copy_
Worksheets("Data").Range("H2").PasteSpecial Paste:=xlPasteValues
Worksheets("Model").Range("C121").Copy_
Worksheets("Data").Range("I2").PasteSpecial Paste:=xlPasteValues
Worksheets("Model").Range("C122").Copy_
Worksheets("Data").Range("J2").PasteSpecial Paste:=xlPasteValues
Then we'd copy the next row of data from the Data tab (i.e., range E3:G3).
This seems like a classic loop scenario, but I don't know how to write it in VBA.

You can do this on a range, I see two ways you can do it, using a copy and paste or simply replicating a transposed version of the data:
'Copy and paste method
Worksheets("Model").Range("C120:C" & range("C" & rows.count).end(xlup).row).Copy 'Using the .end(xlup) will find the last row of data without looping until blank.
Worksheets("Data").Range("H2").PasteSpecial xlPasteValues,,,True 'The True here is what tells the pastespecial to transpose
'Transpose method
Worksheets("Data").Range("H2:J2").Value = application.transpose(Worksheets("Model").range("C120:C122"))
Each have their advantage, the Copy and Paste method is easier because you don't need to know the end column so it works easier for a dynamic range, the transpose method doesn't use the clipboard so is less impact on your system.
The better method code wise would be the transpose method.
You can then set up a simple For Next loop to run through as many data ranges as you want.
Dim DataRow As Long, MyDat As Worksheet, MyModel As Worksheet
Set MyDat = Worksheets("Data")
Set MyModel = Worksheet("Model")
For DataRow = 2 To MyDat.Range("E" & Rows.Count).End(xlUp).Row
MyModel.Range("B4:D4").Value = MyDat.Range("E" & DataRow & ":G" & DataRow).value
Calculate
MyDat.Range("H" & DataRow & ":J" & DataRow).Value = Application.Transpose(MyModel.Range("C120:C122"))
Next

This is a simple loop that finds the last row in "Data" and uses it for the loop defined in "Model".
The expected result of this is that the loop will begin at row 120 and continue until the last row in "Data", copying data from C120 through to C(lRow) and pasting it into the "Data" sheet.
Sub test()
' declare your variables so vba knows what it is working with
Dim lRow, i As Long
Dim wb As Workbook: Set wb = ThisWorkbook
Dim srcws As Worksheet: Set srcws = wb.Worksheets("Data")
Dim destws As Worksheet: Set destws = wb.Worksheets("Model")
' find the last row in Data
lRow = srcws.Cells(srcws.Rows.Count, 1).End(xlUp).Row
' iterate from 120 to the last row found above
For i = 120 To lRow
' copy /paste the data
srcws.cells(1, 3).Copy Destination:=destws.cells(2, 7 + i)
Next i
End Sub

Best way is to use the cells-function, where the first argument is the row and the second is the column. Since you want to inrement the source to copy from by one row at a time but increment the paste destination by one column by a time, this method will be suitable.
In addition, try to not use "copy-paste", focus on setting the value for a cell by referring to a the value attribute from the source to copy. Each time you copy and then paste into the destination, you will need an additional memory cell, resulting in a much longer elapsed time if you are working with a large range to copy.
The code below should do the job.
Sub CopyData()
Dim i As Integer
i = 8 ' Start pasting into column H
' Loop until a blank cell is found
Do While Not Selection.Value = 0
With Sheets("Data").Cells(i + 112, 3)
' Select each cell in "Data", starting on C120
.Select
' Copy the value into "Model", starting on H2
Sheets("Model").Cells(2, i).Value = .Value
End With
Loop
End Sub

Related

How To Copy Range of Last Row of Data and Paste into Row below It

I am trying to to create a macro to get the last row of data on my sheet & copy/paste it into the row before it.
I need it to pick up the data in Columns B-N.
I am able to do it for just column B using the below code but i cant figure out the syntax to get it do do it for column B-N - can someone help?
Sub copylastrow()
Worksheets("Sheet1").Activate
Range("B" & Rows.Count).End(xlUp).Copy
Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
End Sub
Some comments in the code:
Define the source sheet (no need to activate it)
Find the last row in an specific column
Set the source range according to columns and last row
Transfer values without copying them is faster
Assumptions:
Column B is the reference to get the last row
You're just pasting values
Read the comments and adjust the code to fit your needs.
Code
Public Sub CopyLastRow()
' Define the source sheet (no need to activate it)
Dim sourceSheet As Worksheet
Set sourceSheet = ThisWorkbook.Worksheets("Sheet1")
' Find the last row in an specific column
Dim lastRow As Long
lastRow = sourceSheet.Range("B" & sourceSheet.Rows.Count).End(xlUp).Row
' Set the source range according to columns and last row
Dim sourceRange As Range
Set sourceRange = sourceSheet.Range("B" & lastRow & ":N" & lastRow)
' Transfer values without copying them is faster
sourceRange.Offset(1).Value = sourceRange.Value
End Sub
Let me know if it works

How to copy and paste range instead of row?

I am putting together a basic inventory control system and I would like the columns with a time-stamp in the "Checked-Out" column to be pasted into a list on another worksheet. I have successfully copied the correct entire rows, but I would like this to just copy and paste the table rows instead because I have instructions listed in column A that are not relevant for the compiled list. I am new to VBA coding, thanks in advance!
I have named ranges for the two tables called "Inventory_List": Inventory!$I$3:$N$1048576 and "Checked_Out": CheckedOut!$B$3:$G$1048576 as the copy/paste ranges respectively.
Sub testIt()
Dim r As Long, endRow As Long, pasteRowIndex As Long
endRow = 1000 ' of course it's best to retrieve the last used row number via a function
pasteRowIndex = 1
For r = 1 To endRow 'Loop through sheet1 and search for your criteria
If Cells(r, Columns("N").Column).Value > 0 Then 'Found
'Copy the current row
Rows(r).Select
Selection.Copy
'Switch to the sheet where you want to paste it & paste
Sheets("CheckedOut").Select
Rows(pasteRowIndex + 5).Select
ActiveSheet.Paste
'Next time you find a match, it will be pasted in a new row
pasteRowIndex = pasteRowIndex + 1
'Switch back to your table & continue to search for your criteria
Sheets("Inventory").Select
End If
Next r
End Sub
When I try to reference ranges instead of entire rows, I get "run-time error 1004" because my copy area and paste area aren't the same size, but I am a bit confused because my ranges seem to be the same size. I am pretty sure this is because I am adding the ranges to the incorrect portion of the code.
Copying and pasting of Excel ranges is quite standard, if you take into account 2 things:
Refer to the ranges correctly with the upper left cell and the lower right cell;
Always, refer to the Parent worksheet.
In the code below, the upper left cell and the lower right cells of the copied and pasted ranges are like this:
.Range(.Cells(count, 1), .Cells(count, "C"))
copyTo.Range(copyTo.Cells(count, 1), copyTo.Cells(count, "C"))
The parent worksheets are always referred. With with for the copyFrom and with explicit writing for copyTo.
Sub TestMe()
Dim copyFrom As Worksheet
Dim copyTo As Worksheet
Set copyFrom = Worksheets(1) 'Or better write the name - Worksheets("CheckedOut")
Set copyTo = Worksheets(2)
Dim count As Long
For count = 1 To 30
With copyFrom
If .Cells("N", count) > 0 Then
.Range(.Cells(count, 1), .Cells(count, "C")).Copy Destination:=copyTo.Range(copyTo.Cells(count, 1), copyTo.Cells(count, "C"))
End If
End With
Next
End Sub
Last, but not least - this is a must read for VBA - How to avoid using Select in Excel VBA

Add Sum to each worksheet

I have a workbook which will consist of an inconsistent number of worksheets (so could be <10 or >100 at any given time).
The values column will always be in column G on each and every worksheet. I have written the following to achieve a total at the bottom of column G in each worksheet:-
Sub WorksheetLoop()
Dim WS_Count As Integer
Dim I As Integer
Dim LR As Long
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 1 To WS_Count
LR = Range("G" & Rows.Count).End(xlUp).Row
Range("G" & LR + 1).Formula = "=SUM(G4:G" & LR & ")"
Worksheets(ActiveSheet.Index + 1).Select
Next I
End Sub
It runs, however once the final worksheet has been totalled, I get the following runtime error:-
Run-time error '9': Subscript out of range
I've been looking at other threads and applying different approaches, some also work but trigger a runtime error 91.
If I place a end or exit to the for statement it fails after processing just one calculation.
I believe the issue lies in Worksheets(ActiveSheet.Index + 1).Select and falling over when there is no activesheet to process.
Worksheets in a workbook are a Collection. The good thing about collections is that you can step through each item in the collection using a For...Each loop.
The code below will step through each Worksheet in the Worksheets collection in the workbook that contains the code (ThisWorkbook). You can change this to ActiveWorkbook which will do the same for whichever workbook happens to be active at the time.
Rather than return the row number of the last cell in column G the code returns a reference to the actual cell and then Offsets by one row to get the next blank row.
R1C1 style is used for range referencing - R4C means row 4 in whichever column the formula is. R[-1]C means the row above the formula in whichever column the formula is in. So R4C:R[-1]C placed in cell G8 would mean G4:G7.
Sub WorkSheetLoop()
Dim wrkSht As Worksheet
Dim rLastCell As Range
For Each wrkSht In ThisWorkbook.Worksheets
Set rLastCell = wrkSht.Cells(wrkSht.Rows.Count, 7).End(xlUp)
If rLastCell.Row > 4 Then
rLastCell.Offset(1).FormulaR1C1 = "=SUM(R4C:R[-1]C)"
End If
Next wrkSht
End Sub
Why your version doesn't work
The reason why you're getting runtime error #9 is because your code is trying to select a sheet that doesn't exist.
For example, your code starts with the first sheet selected in a two sheet workbook:
Loop 1:
LR is found for the first sheet.
The SUM formula is added to the first sheet.
The second sheet is selected.
Loop 2:
LR is found for the second sheet.
The SUM formula is added to the second sheet.
The code attempts to select the third sheet which doesn't exist - error occurs.
Your code would work if you removed the Worksheets(ActiveSheet.Index + 1).Select line and added Worksheets(I).Select as the first line in your loop.
Also, your code can start with any sheet selected - if the last sheet is active when the code starts then it will add the sum to that sheet and then try and select the next sheet causing it to fail on the first loop.
Once you get to the last worksheet in the worksheets collection, trying worksheets(ActiveSheet.Index + 1).Select is trying to select something that doesn't exist.
Since there is no actual reason to select the worksheet to add a formula, avoid using Select.
Dim I As Integer, LR As Long
For I = 1 To ActiveWorkbook.Worksheets.Count
with ActiveWorkbook.Worksheets(I)
LR = .Range("G" & .Rows.Count).End(xlUp).Row
.Range("G" & LR + 1).Formula = "=SUM(G4:G" & LR & ")"
end with
Next I

Moving all cells into a new single column in Excel

I have an excel file like
Original File
I want to transform all the cells that filled with information into a single column. Like
To transform This
How to i do this ?
I searched in internet about that i found just only transform cells in a single row to a single cell. But i couldn't find anything like this. Can you help me about that
This is a bit of code I keep around for this kind of job. It assumes that the values in each row are contiguous, that is there are no blank cells inside the data set. It also assumes that you're on the sheet that contains the data when you trigger it, and that you want the data to be placed on a new worksheet.
Option Explicit
Sub Columnise()
Dim shtSource As Worksheet
Dim shtTarget As Worksheet
Dim rngRow As Range, rngCol As Range
Dim lCount As Long
Set shtSource = ActiveSheet 'Or specify a sheet using Sheets(<name>)
Set rngCol = Range("A1", Range("A" & Rows.Count).End(xlUp))
Set shtTarget = Sheets.Add 'Or specify a sheet using Sheets(<name>)
'Define starting row for the data
lCount = 1
'Loop through each row
For Each rngRow In rngCol
'On each row, loop through all cells until a blank is encountered
Do While rngRow.Value <> ""
'Copy the value to the target
shtTarget.Range("A" & lCount).Value = rngRow.Value
'Move one space to the right
Set rngRow = rngRow.Offset(0, 1)
'Increment counter
lCount = lCount + 1
Loop
Next rngRow
End Sub
You should end up with all the data in a single column on a new worksheet.
EDITED TO ADD: Since you mentioned your data does contain blank cells, it gets more complicated. We'll want to add a way to continue to the actual end of the data, rather than just looping until we hit a blank cell. We'll modify the Do While... condition to this:
Do While rngCell.Column <= Cells(rngCell.Row, Columns.Count).End(xlToLeft).Column
This will loop until the end of the data in the row, then move on. Give it a shot and let us know.

Re: Take a value (that is summed) in multiple sheets and insert into a master sheet

Re: Creating a master sheet from multiple sheets.
Multiple sheet description: table with many rows and columns. Columns headings are identical but rows vary. Each sheet is a date.
Task: to take a single value from a specific column (always happens to be column M). the value I want is the total of that column. Take this summed value and insert into a master sheet.
My attempt so far is:
Sub append_master_sheet()
Dim wAppend As Worksheet, wSheet As Worksheet
Dim LastRow As Long
Set wAppend = Worksheets("Master")
For Each wSheet In Worksheets
If wSheet.Name <> wAppend.Name Then
LastRow = WorksheetFunction.Max(3, wAppend.Cells(65536, 2).End(xlUp).Row)
wSheet.UsedRange.Resize(, 13).Copy Destination:=wAppend.Cells(LastRow, 2)
End If
Next wSheet
End Sub
1). it takes all 13 columns rather than only the 13th column. (I see that is because I have set it at 13 as I do not know how to cycle through the preceding columns and skip them to only return the 13th column data (and within this column return the total of the column, not the discrete line items
2) Besides returning all the data which is a problem, it actually consistently skips the final value in the column M.
Can you advise how to amend above code to
1) only return the summed value from column M in the multiple sheets (calendar dates) and insert into master.
thanks,
N
Is this what you are trying (UNTESTED)
Like I mentioned in the comment above, see THIS link on how to find a last row in a column.
I have commented the code so that you will not have a problem understanding it. But if you do, simply post back :)
Note: I am assuming that the last cell in Col M has the SUM
Option Explicit
Sub append_master_sheet()
Dim wAppend As Worksheet, wSheet As Worksheet
Dim wApLRow As Long, wShLRow As Long
Set wAppend = ThisWorkbook.Worksheets("Master")
'~~> Get the last row where the ouput should be placed
wApLRow = wAppend.Range("B" & wAppend.Rows.Count).End(xlUp).Row + 1
For Each wSheet In Worksheets
If wSheet.Name <> wAppend.Name Then
With wSheet
'~~> Fuind the last row in Col M which has the sum
wShLRow = .Range("M" & .Rows.Count).End(xlUp).Row
'~~> Copy over the values to Master Sheet
wAppend.Range("B" & wApLRow).Value = .Range("M" & wShLRow).Value
'~~> Increment the row for next output
wApLRow = wApLRow + 1
End With
End If
Next wSheet
End Sub

Resources