I'm trying to look for the last row of data between column A and I and then duplicate the value to the row below which is empty.
Every time I run it, Excel crashes
Sub insert_row()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
LastRow = LastRow
Dim lastrow_start As String
Dim lastrow_end As String
lastrow_start = "A" & LastRow
lastrow_end = "I" & LastRow
Dim lastrowregion As String
lastrowregion = lastrow_start & ":" & lastrow_end
Dim lastrowrange As Range
Set lastrowrange = Range(lastrowregion)
Dim rng As Range
Set rng = Range(lastrow_start)
Do While (rng.Value <> "")
rng.Offset(1).insert
lastrowrange.Copy rng.Offset(1)
Set lastrowrange = rng.Offset(2)
Loop
End Sub
Is it just copying too much and causing a crash? It's only nine columns and they're all text apart from one cell which is a shape (button).
You are trying to set a String to a range object. To get the range use:
Set rng = Range(lastrowregion)
The Range you are getting is A2:I2. So your Do While will error because rng.Value is actually returning an Array. You could either loop through either the Range or the Array at that point if you intended on it being multiple cells.
If the goal is simply to copy the last row of data down one row then this method can be much simpler. You can simply set the Offset to equal the value of the last row. Since they are the same size it will just work.
To show this I used CurrentRegion but you could also do it with your A2:I2 Range.
Public Sub copyLastRowDown()
Dim region As Range
Set region = ThisWorkbook.Worksheets("Sheet1").Range("A1").CurrentRegion
With region.Rows(region.Rows.Count)
.Offset(1).Value = .Value
End With
End Sub
Additional Notes
Use Option Explicit to ensure all variables are explicitly declared.
Declare and assign variables next to where they are going to be used, but place them in a reasonable place.
Do not use underscore case as this has special meaning with events and interfaces.
Related
I have a large sheet of data:
Updated Data
where i need to copy only a speacific part of this data to another worksheet:
The data i need to copy is always 4 cells wide however can be at any row and column. The first column cell at the top will allways be the same text value and i need to copy then from that found cell, 4 cells across to the right and then down to the cells are empty. All subsequent ranges after the first will use the same columns have several empty cells bother above and below each range needed. The macro will be run using a "button" so doesn't need to be checking the value of the cell all the time. The images are simplified versions of the data but are very accurate. 0 is used to show data surrounding range, HELLO is the data inside the range and INT_EXT_DOOR is my searched for cell value which can be in any column between data sets but will be the same inside each data set. The first range always starts at row 2.
Each range has to be numbered, defined by another worksheets cell value. For example, if my cell value is 1 i need it to copy range 1, if my value is 2 copy range 2 ect.
I have been trying to no luck to get anything that works like needed and would appreciate any help, thanks.
Test the next function, please:
Private Function testReturnBlock(strBlock As String, blkNo As Long)
Dim sh As Worksheet, ws As Worksheet, lastRow As Long, searchC As Range
Dim rng As Range
Set sh = ActiveSheet ' use here your sheet to be processed
Set ws = Worksheets("Return") 'use here your sheet where the data will be returned
Set searchC = sh.UsedRange.Find(strBlock)
If searchC Is Nothing Then MsgBox "No such a field in the worksheet...": Exit Function
lastRow = sh.Cells(Rows.Count, searchC.Column).End(xlUp).row
'The following part works well only if the blocks are separated by empty rows, as you said it is your sheet data case...
Set rng = sh.Range(searchC, sh.Cells(LastRow, searchC.Column)).SpecialCells(xlCellTypeConstants)
ws.Range("A1").Resize(rng.Areas(blkNo).Rows.Count, 4).Value = rng.Areas(blkNo).Resize(, 4).Value
End Function
The above function should be called like this:
Sub testRetBlock()
testReturnBlock "INT_EXT_DOOR", 2
End Sub
But in order to see that the correct range has been returned, you must adapt them in a way (in your test sheet), do differentiate. I mean the second one to contain "HELLO1" (at least on its first row), the following "HELLO2" and so on...
Try this routine if it does what you need. otherwise it should be a good start for adding whatever you need on top.
Option Explicit
Sub CopyBlock()
Dim wb As Excel.Workbook
Dim wsSource As Excel.Worksheet
Dim wsDest As Excel.Worksheet
Dim wsSelect As Excel.Worksheet
Dim lBlockNo As Long
Dim strCellID As String
Dim lBlock As Long
Dim lRow As Long
Dim lBlockRow As Long
Dim lBlockCol As Long
Dim searchRange As Excel.Range
Dim bRange As Excel.Range
Dim cRange As Excel.Range
Set wb = ActiveWorkbook
' set the worksheet objects
Set wsSource = wb.Sheets("Source")
Set wsDest = wb.Sheets("Dest")
Set wsSelect = wb.Sheets("Select") ' here you select which block you want to copy
' Identifier String
strCellID = "INT_EXT_DOOR"
' Which block to show. We assume that the number is in cell A1, but could be anywhere else
lBlockNo = wsSelect.Range("A1")
lRow = 1
' Find block with lBlockNo
For lBlock = 1 To lBlockNo
' Search the identifier string in current row
Do
lRow = lRow + 1
Set searchRange = wsSource.Rows(lRow)
Set bRange = searchRange.Find(strCellID, LookIn:=xlValues)
Loop While (bRange Is Nothing)
Next lBlock
lBlockRow = bRange.Row
lBlockCol = bRange.Column
' Search the first with empty cell
Do
lRow = lRow + 1
Loop While wsSource.Cells(lRow, lBlockCol) <> ""
' Copy the range found into the destination sheet
Range(Cells(lBlockRow, lBlockCol), Cells(lRow - 1, lBlockCol + 3)).Copy wsDest.Range("A1")
' Note the block copied
wsDest.Cells(1, 6) = "Block No:"
wsDest.Cells(1, 8) = lBlockNo
' Clean up (not absolutely necessary, but good practice)
Set searchRange = Nothing
Set bRange = Nothing
Set cRange = Nothing
Set wsSource = Nothing
Set wsDest = Nothing
Set wsSelect = Nothing
Set wb = Nothing
End Sub
Let me know if you need more help
I have a column in one sheet
I am trying to transfer it to another sheet on the same workbook. It must appear like the image below. The values must appear after the first ID column.
I tried the code below after reading and watching videos. I am further trying to identify the lastrow in Sheet2 and paste the values from Sheet1 to the next available row.
Sub Transpose()
Dim SourceSheet As Worksheet
Dim TransferSheet As Worksheet
Dim inRange, outRange As Range
Dim finalrow As Integer
Dim i As Integer
'Assign
Set SourceSheet = Sheets("Sheet1")
Set TransferSheet = Sheets("Sheet2")
SourceSheet.Activate
Set inRange = ActiveSheet.Range("B2:B11")
inRange.Copy
'TRANSFER
TransferSheet.Activate
finalrow = TransferSheet.Cells(Rows.Count, 1).End(xlUp).Row 'find last row
For i = 2 To 11
outRange = TransferSheet.Range(Cells(ii, finalrow), Cells(ii, finalrow))
outRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Next i
End Sub
Here is an example following on from my comments
Option Explicit
Public Sub MyTranspose()
'This assumes column to row transpose
Dim SourceSheet As Worksheet, TransferSheet As Worksheet
Dim inRange As Range, inRangeValues() As Variant, outRangeValues() As Variant
Dim finalRow As Long
Set SourceSheet = ThisWorkbook.Worksheets("Sheet1") 'Assign reference
Set TransferSheet = ThisWorkbook.Worksheets("Sheet2")
Set inRange = SourceSheet.Range("B2:B11")
inRangeValues() = inRange.Value 'generate 2d array
outRangeValues = Application.Transpose(inRangeValues)
With TransferSheet 'Hold reference to parent worksheet
finalRow = .Cells(Rows.Count, 1).End(xlUp).Row 'find last row
If inRange.Columns.Count > 1 Then '2d array for output
.Cells(finalRow + 1, 2).Resize(UBound(outRangeValues, 1), UBound(outRangeValues, 2)) = outRangeValues 'Resize according to output array dimensions
Else '1D array for output
.Cells(finalRow + 1, 2).Resize(1, UBound(outRangeValues, 1)) = outRangeValues
End If
End With
End Sub
These were my comments (plus a bit):
Use Long rather than Integer, inRange needs to be explicitly declared as Range not implicitly as Variant. With Dim inRange, outRange As Range only outRange is a Range. You need Dim inRange As Range, outRange As Range.
You need Set when creating reference to Range object e.g. Set outRange = TransferSheet.Range(Cells(ii, finalrow), Cells(ii, finalrow)); here Cells will refer to currently active sheet and ii is never declared, but you are using a loop variable called i - typo? Other than that I am not sure pastespecial will work there either.
I would (depending on size of inRange as Transpose has a limit and will truncate or complain after that) read into array, use Transpose function and write out with Resize.
Use Worksheets collection not Sheets. Fully qualify cells references with parent sheet names; As you have these in variables just use the appopriate variable names. You don't need Activesheet and Activate this way and thus your code will be less bug prone (explicit sheet reference) and faster (due to not Activating sheet).
Give your sub a different name from the existing VBA method (something better, yet still descriptive, than I have used.
Try this, please:
Dim SourceSheet As Worksheet, TransferSheet As Worksheet
Dim rowVal As Variant, nrCol As Long, ColumnLetter As String
Set SourceSheet = ActiveWorkbook.Sheets("Sheet1")
Set TransferSheet = ActiveWorkbook.Sheets("Sheet2")
rowVal = SourceSheet.Range("B2:B11")
nrCol = UBound(rowVal)
ColumnLetter = Split(Cells(1, nrCol + 1).Address, "$")(1)
TransferSheet.Range("B2:" & ColumnLetter & 2) = Application.WorksheetFunction.Transpose(rowVal)
So, the code declares both pages as you did.
Then the range in B:B column is included in the rowVal array. The number of columns is defined like Ubound(rowVal) and the Column letter of the sheet to paste the values is determined like ColumnLetter. nrCol + 1 is used because the paste cell will be in B:B column (the second one) and counting does not start from the first column.
Then, using Transpose function the array content is pasted in the TransferSheet appropriate row. The range column is built using the previous determined ColumnLetter...
I want to copy all filled cells starting from C5 to column F of a different worksheet.
I referred to another post: Excel - Combine multiple columns into one column
Modified the code based on my needs.
Sub CombineColumns()
Dim Range1 As Range, iCol As Long, Range2 As Range, Check As Range, wks As Worksheets
Set Range1 = wks("T(M)").Range(Cells(5, 3), Cells(Cells(5, 3).End(xlDown).Row, Cells(5, 3).End(xlToRight).Column))
Set Check = wks("csv").Range("F1")
If IsEmpty(Check.Value) = True Then
Set Range2 = Check
Else
LastRow = wks("csv").Range("F" & Rows.Count).End(xlUp).Row
Set Range2 = wks("csv").Cells(LastRow, 6).Offset(1, 0)
End If
For iCol = 3 To Range1.Columns.Count
wks("T(M)").Range(Cells(5, iCol), Cells(Range1.Columns(iCol).Rows.Count, iCol)).Copy
wks("csv").Range2.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Next iCol
End Sub
But I kept getting the error message
"object doesn't support this method or property"
at the step of pasting. After I tried to qualify all the ranges, It says I didn't set the object variable.
Thank you so much for the help!
How about this?
Sub Transposes()
' Example just for hardcoded data
Dim inputRange As Range
Set inputRange = Sheets("Sheet1").Range("C5:F10").SpecialCells(xlCellTypeConstants)
Dim outputCell As Range
Set outputCell = Sheets("Sheet2").Range("A1")
Dim cell As Range
For Each cell In inputRange
Dim offset As Long
outputCell.offset(offset).Value = cell.Value
offset = offset + 1
Next cell
End Sub
Set the last row in ColumnF to be whatever you want, and if that changes dynamically, just use any one of the multiple techniques out there to find the last cell you need to copy/paste.
Hi this is my first post and i am newbie when it comes to VBA.
So i tried the last 6 hours to accomplish one task.
I already managed to get the code for the For each loop and it works and copies the value to the existing workbook. But i couldnt find out why it always copies the value to A2 and not further to A3/A4/A5 and so on .
I tried these piece of code " range = range + 1 " but i keep getting runtime errors and it still copies the values to A2 and overwrites it when it gets a new value from the loop.
I think its only a litte change needed but i cant figure it out. :(
Sub copie1()
Dim ws As Worksheet
Dim cell As Range
Dim targetsheet As Worksheet
Dim target As Range
Dim rngTemp As Range
Set wkba = ActiveWorkbook
Worksheets("cop1").Activate
LR = Cells(Rows.Count, "A").End(xlUp).Row
LT = Cells(Rows.Count, "X").End(xlUp).Row
Set rngTemp = Range("X2:X" & LT)
Workbooks.Open Filename:="C:\Users\path......."
Set targetsheet = Worksheets("Data")
Set target= targetsheet.Range("A1")
For Each cell In rngTemp
If cell > 0 Then
target.Offset(1, 0) = cell.Value
End If
target = target+1 '// is this right?
Next cell
End Sub
my goal is the loop through column X in a Workbook and copy every single data that is bigger than 0 ( because there are empty cells & cells with value 0)
and paste it in an existing workbook in range A2/A3/A4 and so on
You can't add the number one to a Range object.
Try replacing target = target+1 '// is this right? with:
Set target = target.Offset(1)
Does this resolve the problem?
SibSib1903, I have added below a simple example that you can easily adapt to your own requirements. It looks at all cell values in column A and any numeric value greater than zero is copied to column C starting in row 1. For example, if column A contains 45 rows with data, and only three of these rows have a numeric value greater than zero, these three values will copied in column C in the first three rows.
Public Sub copieTest()
Dim ws As Worksheet, cell As Range, rngX As Range
Dim tmpVal As Variant, counter As Long
Set ws = ThisWorkbook.Worksheets("cop1")
Set rngX = ws.Range("A1:A" & ws.Cells(ws.Rows.count, 1).End(xlUp).Row)
counter = 1
For Each cell In rngX
tmpVal = Val(Trim(cell.Value))
If tmpVal > 0 Then
ws.Range("C" & counter).Value = tmpVal
counter = counter + 1
End If
Next cell
Set rngX = Nothing: Set ws = Nothing
End Sub
Very new to VBA. i am having trouble declaring a variable as a specific cell on a worksheet.
I have tried defining the cell by rows and columns but when I put a watch on the line it says Value is out of context. The variable is testname and it is in cell E2 of the worksheet I have set as the variable raw.
Sub findcomponents()
Dim raw As Worksheet
Dim res As Worksheet
Dim temp As Worksheet
Dim testname As String
Dim finalrow1 As Integer
Dim finalrow2 As Integer
Dim i As Integer
Set raw = Worksheets("rawdata")
Set res = Worksheets("resultcomponents")
Set temp = Worksheets("uploadtemplate")
testname = raw.Range("E2").Value
finalrow1 = raw.Range("A10000").End(xlUp).Row
finalrow2 = res.Range("A10000").End(xlUp).Row
For i = 2 To finalrow2
If res.Cells(i, 4) = testname Then
Range(Cells(i, 2), Cells(i, 4)).Copy
temp.Range("A10000").End(xlUp).Cells("A2").Paste
End If
Next i
End Sub
I expect the value to be the string in the E2 cell
Edit: I added the rest of the code. When I run it doesn't do anything.
It is supposed to take the string testname and loop through a list on the res worksheet and return the matches. I put a watch on the testname line because i thought it would show me that it was comparing the correct string and the Value in the watch line says
yes the paste line is incorrect. I also tried temp.Range("A10000").End(xlUp).Offset(1, 0).Paste and this makes it angry also.
The fix works with an edit on the worksheet name. But there is more than 1 match on the res worksheet. That is why I thought finding the the last row (but I should have offset 1 row) would return all the matches. This does work to return all values.
temp.Range("A10000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Is there a better way to do this not using Range("A10000").End(xlUp)?
Your key problem is with the paste statement.
You can use one of the two following methods to paste (although it should be noted that there are others)
Range.Copy PasteRange
or
Range.Copy
PasteRange.PasteSpecial (paste type (values, formats, etc.))
This has also been updated with more standard variable blocks/variable names for Last Row calculations. Also, notice that I have also updated the Last Row calculation to be a little more dynamic. Lastly, swapping Integer for Long
Option Explicit
Sub findcomponents()
Dim raw As Worksheet: Set raw = ThisWorkbook.Sheets("rawdata")
Dim res As Worksheet: Set res = ThisWorkbook.Sheets("resultcomponents")
Dim temp As Worksheet: Set temp = ThisWorkbook.Sheets("uploadtemplate")
Dim testname As String
Dim LR1 As Long, LR2 As Long, LR3 As Long, i As Long
LR1 = raw.Range("A" & raw.Rows.Count).End(xlUp).Row '<-- This variable is never used??
LR2 = res.Range("A" & res.Rows.Count).End(xlUp).Row '<-- Updated for standard Last Row (LR) calculation
For i = 2 To LR2
If res.Cells(i, 4) = raw.Range("E2") Then
res.Range(res.Cells(i, 2), res.Cells(i, 4)).Copy '<-- Qaulified Ranges!!
LR3 = temp.Range("A" & temp.Rows.Count).End(xlUp).Offset(1).Row
temp.Range("A" & LR3).PasteSpecial xlPasteValues '<-- Correct Paste Method
End If
Next i
End Sub
The naming conventions used are just my preference. To an extent, you are free to name variables however you see fit