VBA - Copy and Paste Dynamic Range with Dynamic Start Point - vba

I am very new to the VBA community and usage so my illiteracy is a bit embarrassing. I work in a lab that routinely deals with very large data output files. In order to statistically analyze these data files we often have to rearrange the output data into a more statistically friendly format. Therein lies my problem.
I have created and VBA that does this for a very specific dataset, copying and paste transposing 5 data points at a time. I would like help in creating something that allows me to have a more generic approach to this where I might be able to enter the number of study time points (typically between 3 and 10) and the number of study participants (between 10 and 100) and still get the copy/paste transpose done on the correct sheet.
What I have in my specific VBA is below. I basically have this done manually all the way to a range of B208:212 and all the way through Sheet 13.
Sheets("Raw Data").Select
Range("B3:B7").Select
Selection.Copy
Sheets("Sheet1").Select
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
What this does is copies five data points for one study participant, goes to my desired sheet, and paste transposes in the row corresponding with my study participant. I need to do this for up 100 study participants, each beginning on its own row starting with D2.
Sorry this is confusing. I am working on posting more clarification below.

Sheets("Raw Data").Select
Range("B3:B7").Select
Selection.Copy
Sheets("Sheet1").Select
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
reduces to
Sheets("Sheet1").Range("D2").Resize(5, 1).Value = _
Application.Transpose(Sheets("Raw Data").Range("B3").Resize(1, 5).Value)
Taking that as a starting point, you can declare some variables (or better, use Constants) for the "5", etc, but you'd need to add some more details to your question, including what dtermines where the next "paste" point is. you mention multiple sheets but it's not clear how those are involved in the operation.
Eg:
Sub Tester()
Const DATA_PTS As Long = 5
Dim rngCopy As Range, rngPaste As Range
'start point for source data
Set rngCopy = Sheets("Raw Data").Range("B3").Resize(DATA_PTS, 1).Value
Do While Application.CountA(rngCopy) > 0
'Set rngPaste = ? 'what determines where data is copied to?
rngPaste.Resize(1, DATA_PTS).Value = _
Application.Transpose(rngCopy.Value)
'next source range
Set rngCopy = rngCopy.Offset(DATA_PTS, 0)
Loop
End Sub

Related

VBA not updating Excel rows referring to other sheets in same workbook when sorting rows alphabetically

I'm having problems, Excel is not updating rows referring to other sheets in same workbook when ordering rows alphabetically.
I have a userform in which there's a button insertCM with this code:
Private Sub insertButton_Click()
ActiveCell.EntireRow.Select
Selection.Insert Shift:=xltoDown
Range("A9:AK9").Copy
Range("A8:AK8").Select
Selection.PasteSpecial Paste:=xlPasteFormulas
Selection.PasteSpecial Paste:=xlPasteFormats
Range("C10").Copy
Range("C8:C9").Select
Selection.PasteSpecial Paste:=xlPasteFormulas
Range("H9:AK9").Copy
Range("H8:AK8").Select
Selection.PasteSpecial Paste:=xlPasteAll
nomCM = Empty
CXinitial = Empty
resteCX = Empty
CCselect = Empty
C4initial = Empty
resteC4 = Empty
compteurCT = Empty
Range("A8").Activate
ActiveCell.RowHeight = 18.6
For i = 2 To ThisWorkbook.Sheets.Count
With Sheets(i).Select
emptyRow = Range("A9").End(xlDown).Offset(0, 2).Row
Range("A9:AL" & emptyRow).Sort _
Key1:=Range("A9"), Order1:=xlAscending
Set SearchRange = Range("A8", Range("A200").End(xlUp))
Set FindRow = SearchRange.Find(nomCM, LookIn:=xlValues, LookAt:=xlWhole)
Range("A" & FindRow.Row).Select
ActiveCell.EntireRow.Activate
End With
Next i
Sheet2.Select
End
End Sub
The userform is used for inserting new clients in several sheets at the same time. Textbox inserts Name, Cost Center, etc., in a blank row and insertButton inserts a new row leaving data inserted in row 8 to go to row 9. After that the code puts all rows alphabetical order so the new client now in row 9 goes to the new one, and cells containing formulas change row numbers.
However some of the sheets have cells containing references to other sheets' cells in the same row. So imagine:
I insert client name "LORUM" "Cost Center 4" and it puts him in row 9 so formula is:
=$C9-COUNTIF($E9:$P9;"CT")+'Sheet5'!$D9
...but when it changes his row to the final one, formula row is:
=$C18-COUNTIF($E18:$P18;"CT")+'Sheet5'!$D9
It does not change row when referring to other sheets.
Any ideas?
It's looks like you've made a good effort, but there are still numerous problems with your code (beside the one line), and I can guarantee that a combination of these issues are preventing your intended outcome.
I can't fix it completely because there are so many bugs that I'm not clear on what you're trying to do, but hopefully this will get you started on the right track...
xlToDown is not a valid reference. You probably mean xlDown
you have a number of undeclared variables and objects, like: i, emptyRow, SearchRange, FindRow, nomCM
you have things (objects?) "set to nothing" that aren't declared or used anywhere: CXinitial, resteCX, CCselect, C4initial, resteC4, compteurCT
your Find statement is looking for nomCM which is empty (and never set), so the Find statement will never find anything.
You should put Option Explicit at the top of every module (especially when learning or troubleshooting). This will prevent issues like the ones above by "forcing" you to properly declare & handle all of your variables, objects, properties, etc.
Near the end, you refer to Sheet2.Select as if Sheet2 is a declared object, instead of using Sheets("Sheet2").Select. I'm not sure why you're selecting the sheet at the very end anyhow.
You have an With..End statement that is doing absolutely nothing since you don't reference it with a . dot anywhere: With Sheets(i).Select .. End With, and also Select isn't used like that.
A mystery End near the end for some reason.
Also, you're unnecessarily doubling up commands like:
ActiveCell.EntireRow.Select
Selection.Insert Shift:=xlDown
..instead of:
ActiveCell.EntireRow.Insert Shift:=xlDown
and another example, all this:
Range("A9:AK9").Copy
Range("A8:AK8").Select
Selection.PasteSpecial Paste:=xlPasteFormulas
Selection.PasteSpecial Paste:=xlPasteFormats
Range("C10").Copy
Range("C8:C9").Select
Selection.PasteSpecial Paste:=xlPasteFormulas
Range("H9:AK9").Copy
Range("H8:AK8").Select
Selection.PasteSpecial Paste:=xlPasteAll
...instead of:
Range("A9:AK9").Copy
Range("A8:AK8").PasteSpecial xlPasteValuesAndNumberFormats
Range("C10").Copy
Range("C8:C9").PasteSpecial Paste:=xlPasteFormulas
Range("H9:AK9").Copy Range("H8:AK8")
All of this would be more clear by Googling the documentation for each command you're unfamiliar with, such as:
Range.Copy Method (Excel)
Range.PasteSpecial Method (Excel)
XlPasteType Enumeration (Excel)
All the ActiveCell and ThisWorkbook references are troublesome but again, I'm not sure what to do with them since I don't know your workbook.
Indentation (and general organization) are very important as well. It may not change the way that the code runs, but it will help you (and others) track down existing & potential issues more easily.
Here is your code cleaned up as best as I could:
Option Explicit 'this line goes at the very top of the module
Private Sub insertButton_Click()
Dim i As Long, emptyRow As Long, SearchRange As Range, FindRow As Range, nomCM
nomCM = Empty
ActiveCell.EntireRow.Insert Shift:=xlDown
Range("A9:AK9").Copy
Range("A8:AK8").PasteSpecial xlPasteValuesAndNumberFormats
Range("C10").Copy
Range("C8:C9").PasteSpecial Paste:=xlPasteFormulas
Range("H9:AK9").Copy Range("H8:AK8")
Range("A8").RowHeight = 18.6
For i = 2 To ThisWorkbook.Sheets.Count
With Sheets(i)
emptyRow = .Range("A9").End(xlDown).Offset(0, 2).Row
.Range("A9:AL" & emptyRow).Sort Key1:=.Range("A9"), Order1:=xlAscending
Set SearchRange = .Range("A8", .Range("A200").End(xlUp))
Set FindRow = SearchRange.Find(nomCM, LookIn:=xlValues, LookAt:=xlWhole)
.Range("A" & FindRow.Row).Select
ActiveCell.EntireRow.Activate
End With
Next i
Sheets("Sheet2").Select
End Sub
as per my test, sorting actually doesn't change other sheet direct references
so you may want to use OFFSET to keep referencing the actual current row index
instead of:
=$C9-COUNTIF($E9:$P9;"CT")+'Sheet5'!$D9
use
=$C9-COUNTIF($E9:$P9;"CT")+ OFFSET('Sheet5'!$D1,ROW()-1,0)
I found a solution:
=INDIRECT(ADDRESS(ROW();4;3;1;"Sheet5"))
Where Row() will always refer to the actual cell's row.
Hope it will help you!

Macro : Copy Range to Next Consecutive Blank Column(s)

everyone. Newbie here.
I have tried to the best of my knowledge and ability to go through the hundreds of macro codes that allows the user to specifically click a button to copy and paste a range into the next blank column, and keep pasting new columns as long as the user clicks the button. Unfortunately, the small variations in the purpose of the codes created will differ. I am unable to understand why.
I have managed last night to hit the jackpot and make it work flawlessly, until it crashed for some reason just as I saved the file. It didn't work after that.
The objective: for analysis purposes, the range in C9:C43 will always be there as a base year data. If the user has one year worth of data, then no need to copy. If the user has 5 years worth of data, the user will click the button 5 times. The copy will include formats, formulas, and column widths.
Furthermore, considering that the range in column C is the base, cell C9 will resemble the Year i.e. 2015. If the user changes C9 to, say, 2010, the following column will have D9 = 2011, and so on.
I thought a dialogue box will be a better representation of the objective I'm working on, but seems to be far-fetched with my current understanding of Macros and VBA.
Here is the code I used last night that got it working before it crashed mysteriously after saving the file:
Dim rngSource As Range
Dim rngDestination As Range
Set rngSource = Range("C9:C43")
Set rngDestination = Cells(9, Columns.Count).End(xlToLeft).Offset(0, 1)
Range("C9:C43").Copy
Range("D9").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("D9").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=RC[-1]+1"
rngSource.Copy destination:=rngDestination
You guys are amazing and your work and cooperation is deeply appreciated.
Warm regards,
While this doesn't answer your question about freezing code, I believe it may help you with your fundamental problem of copying columns in a series
If you use cell A1 for a user to specify how many columns they would like to add, then a button press could call range.autofill with a series fill (this works for the year but I'm not sure what you have underneath that top row)
Sub Button_Click()
Dim x As Integer
x = Range("A1").Value
Range("C9:C43").AutoFill Destination:=Range("C9:" & Cells(43, x + 3).Address), Type:=xlFillSeries
End Sub

Copy and Paste (transposed & values) a set range in a different sheet in the next empty row

I have some data in range P1:R13 on a sheet called Training Analysis.
I want to copy and paste these data on a second sheet called Foglio1. I want it to be just values. I need these data to be pasted in a range A2:M4, in other words I want it to be transposed.
I got the following code and it is working. But now, when I get new data I need to paste them under those I already have.
Sub add()
Dim lastrow As Long
lastrow = Sheets("Foglio1").Range("A65536").End(xlUp).Row ' or + 1
Range("P1:R13").Copy Destination:=Sheets("Foglio1").Range("A" & lastrow)
End Sub
It does the empty space but I don't know how to change it to make it transpose the data and give me only values.
Can you help me change it ? If you have new options its fine too.
Cheers
What you need to do when you have a question like this is to record a macro, understand how it works and then clean up the code.
This is what you will get after doing what you need manually and recording it:
Range("P1:R13").Select
Selection.Copy
Sheets("Foglio1").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
After you clean it up a bit and add determining the last row this is what you should get:
Dim lastRow As Long
Sheets("Training Analysis").Range("P1:R13").Copy
lastRow = Sheets("Foglio1").Range("a65536").End(xlUp).Row
Sheets("Foglio1").Range("A" & lastRow + 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
In this particular case you didn't know that you need to use the PasteSpecial method but this is okay: you don't need to remember the entire Excel object model by heart. You can use the 'record, clean up and modify' method whenever you are in a situation like this.
You could shorten it further and try:
Sub add()
Range("Foglio1!A2:M4").Value2 = Application.WorksheetFunction.transpose(Range("Training Analysis!P1:R13").Value2)
End Sub
This is, of course, adapted to this specific case, so, for further use, you must ensure you update the sheet names and ranges(if they change). You also have to check by yourself that the areas are equivalent (e.g. 15x2 to 5x6 cells). These checks can be added in the procedure, but the code above should do the trick for the moment.
EDIT: I saw your specification a bit too late. :)
Here is the adapted code, which should find the first available row on sheet "Foglio1", column A, and will paste the transposed values onto a 3x13 area. Give it a go.
Sub add2()
With Sheets("Foglio1")
.Cells(.Range("A" & .Rows.Count).End(xlUp).Row + 1, 1).Resize(3, 13).Value2 = _
Application.WorksheetFunction.Transpose(Sheets("Training Analysis").Range("P1:R13").Value2)
End With
End Sub
EDIT 2: updated add2 so that the source range would refer to sheet "Training Analysis" and prevent error# 1004.

Multiple data sets, input into separate workbook, output each dataset into own field

I am very new, never done programming before and never used a forum before. I have read a lot of other posts to get as far as I have done in Excel to try and get it to perform as I require.
Basically I have a number of data sets, each with 4 variables, each set needs to be copied into appropriate fields on another worksheet, then the 2 outputs from this, recorded back onto the first sheet in 2 separate columns for each data set.
I have got the macro to do nearly all of it however it pastes only the last set of data outputs in the cells not each individual set.
Unfortunately I appear not to be able to add screen shots.
Currently my macro text is:
Sub macro1()
Dim rCell As Range
Dim rRng As Range
Set rRng = Sheet1.Range("C2:C6")
For Each rCell In rRng.Cells
rCell.Copy
Sheets("Sheet2").Select
Range("C2").Select
Sheets("Sheet2").Paste
Next rCell
Dim rCell2 As Range
Dim rRng2 As Range
Set rRng2 = Sheet1.Range("D2:D6")
For Each rCell2 In rRng2.Cells
rCell2.Copy
Sheets("Sheet2").Select
Range("D2").Select
Sheets("Sheet2").Paste
Range("C8").Select
Selection.Copy
Sheets("Sheet1").Select
Range("J2:J6").PasteSpecial Paste:=xlPasteValues
Next rCell2
Dim rCell3 As Range
Dim rRng3 As Range
Set rRng3 = Sheet1.Range("E2:E6")
For Each rCell3 In rRng3.Cells
rCell3.Copy
Sheets("Sheet2").Select
Range("E2").Select
Sheets("Sheet2").Paste
Next rCell3
Dim rCell4 As Range
Dim rRng4 As Range
Set rRng4 = Sheet1.Range("F2:F6")
For Each rCell4 In rRng4.Cells
rCell4.Copy
Sheets("Sheet2").Select
Range("F2").Select
Sheets("Sheet2").Paste
Range("D8").Select
Selection.Copy
Sheets("Sheet1").Select
Range("K2:K6").PasteSpecial Paste:=xlPasteValues
Next rCell4
End Sub
Apologies for the repetition, I hope someone can help.
Also if there are any good books that people can rate to learn basic macro and programming language that would be great.
You are using Range variables which is good but you are then using Select which should be avoided.
If you want to copy from Sheets("Sheet1").Range("C2:C6") and paste into Sheets("Sheet2").Range("C2:C6"), you can do this in one line of code. You do not need to loop through the cells for this:
Sheets("Sheet1").Range("C2:C6").Copy Sheets("Sheet2").Range("C2")
Your code as posted was looping through the cells but was always pasting into the same cell.
You can copy a larger block of code and it looks like your code is trying to copy cells C2:F6. Normally you can do that with one line:
Sheets("Sheet1").Range("C2:F6").Copy Sheets("Sheet2").Range("C2")
But maybe the paste special causes the values in columns D & E to get changed?
The PasteSpecial method requires two lines of code but this seems ok in your code. These lines of code copies one value and pastes it into five cells:
Sheets("Sheet2").Range("C8").Copy
Sheets("Sheet1").Range("J2:J6").PasteSpecial Paste:=xlPasteValues
You can simplify your code to:
Sheets("Sheet1").Range("C2:C6").Copy Sheets("Sheet2").Range("C2")
Sheets("Sheet1").Range("D2:D6").Copy Sheets("Sheet2").Range("D2")
Sheets("Sheet2").Range("C8").Copy
Sheets("Sheet1").Range("J2:J6").PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("E2:E6").Copy Sheets("Sheet2").Range("E2")
Sheets("Sheet1").Range("F2:F6").Copy Sheets("Sheet2").Range("F2")
Sheets("Sheet2").Range("D8").Copy
Sheets("Sheet1").Range("K2:K6").PasteSpecial Paste:=xlPasteValues
And maybe copy larger blocks of cells to reduce the number of copy operations?
Sheets("Sheet1").Range("C2:D6").Copy Sheets("Sheet2").Range("C2")
Sheets("Sheet2").Range("C8").Copy
Sheets("Sheet1").Range("J2:J6").PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("E2:F6").Copy Sheets("Sheet2").Range("E2")
Sheets("Sheet2").Range("D8").Copy
Sheets("Sheet1").Range("K2:K6").PasteSpecial Paste:=xlPasteValues

Make code more efficient or quicker [closed]

Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 8 years ago.
Improve this question
Hi I've been using various bits of code to help me get to where I need.
The spreadsheet updates the quantity of a stock item in a main table (worksheet "Stock") with a value from "JDW" worksheet.
The VBA Code filters the main table to find the correct part number based on an input on the JDW worksheet.
The code then loops until it finds the first row that is NOT "hidden" by the filter. This is the bit that takes ages - an offset only moved it to row 2 not row "x" - this could be anything from row 2 to 5000.
The code then offsets to the correct cell, copies pastes, and then offsets again and copies the date and pastes the date value in to the next cell (adds date to a column titled "Last updated")
The code then clears the input form of the data as a basic "reset".
Any suggestions?
Range("C4").Select
Selection.Copy
Sheets("Stock").Select
ActiveSheet.Range("$A$1:$X$5000").AutoFilter field:=1, Criteria1:=Worksheets("JDW").Range("C4").Value
Range("A1").Select
ActiveCell.Offset(1, 0).Activate
Do Until Selection.EntireRow.Hidden = False
If Selection.EntireRow.Hidden = True Then
ActiveCell.Offset(1, 0).Activate
End If
Loop
Selection.Offset(0, 16).Select
Sheets("JDW").Select
Range("C20").Select
Selection.Copy
Sheets("Stock").Select
ActiveSheet.Paste
Selection.Offset(0, 2).Select
Sheets("JDW").Select
Range("A1").Select
Selection.Copy
Sheets("Stock").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Range("$A$1:$X$5000").AutoFilter field:=1
Sheets("JDW").Select
Range("C20").Select
Selection.ClearContents
Two things...
Firstly, there is a method on a range to do .SpecialCells(xlCellTypeVisible). You can loop through this and work only with the visible cells.
Secondly, get rid of Select and Selection - it is bad practice and slow. For example, refer to things like Sheets("JDW").Range("C20") and rather than use the copy/paste buffer you could do things like Sheets("Stock").Cells(1,2).Value = Sheets("JDW").Range("C20").value to put a value in directly...
Don't select other ranges all the time: You can get values, copy or paste without changing the selection.
Loop through the rows instead of through the cells, do you don't have to apply the EntireRow function
Avoid taking the wrong address first and then using .Offset to go to the right one
If you just need to copy a value, do not copy the cell. Read the value from the source and write it to the destination.
This reduces the code to
Sheets("Stock").Range("$A$1:$X$5000").AutoFilter _
field:=1, Criteria1:=Worksheets("JDW").Range("C4").Value
Dim StockRow as range
Set StockRow = Sheets("Stock").Rows(2)
Do Until StockRow.Hidden = False
Set StockRow = StockRow.Offset(RowOffset:=1)
Loop
StockRow.Cells(1,17).Value = Sheets("JDW").Range("C20").Value
StockRow.Cells(1,19).Value = Sheets("JDW").Range("A1").Value
Sheet("Stock").Range("$A$1:$X$5000").AutoFilter field:=1
Sheets("JDW").Range("C20").ClearContents
(Not tested because I don't have the context)
But actually you can do even better with
Dim StockRow as range, stockKey as variant
stockKey = Sheets("JDW").Range("C4").Value
Set StockRow = Sheets("Stock").Columns(1).Find(stockKey, LookAt:=xlWhole)
...