I receive a "subscript out of range" at the line starting: Sheets(“Sheet1”).Cells("A", i).EntireRow.Copy . How do I copy and paste the row to the first open row in Sheet2.
Sub IDwalkups()
Dim endRow As Long
Dim Match1() As Variant
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
ICount = 0
endRow = Sheet1.Range("B999999").End(xlUp).Row
Match1 = Sheet1.Range("E3:E" & endRow)
For i = LBound(Match1) To UBound(Match1)
If Match1(i, 1) = "W" Then
Sheets(“Sheet1”).Cells("A", i).EntireRow.Copy Destination:=Sheets (“Sheet2”).Range(“A” & Rows.Count).End(xlUp).Offset(1)
Else
End If
Next i
End Sub
The three errors you have are:
using “ and ” instead of ". For instance, “Sheet1” is a valid variable name and can be used in statements such as “Sheet1” = 5 * 2. Syntactically, it is quite different to "Sheet1" which is a string literal.
Using Cells("A", i) instead of Cells(i, "A") - the first parameter of Cells is the row, and the second parameter is the column.
Not qualifying which sheet you are referring to when using Rows.Count (but there is a good chance that this would have worked anyway)
So
Sheets(“Sheet1”).Cells("A", i).EntireRow.Copy Destination:=Sheets (“Sheet2”).Range(“A” & Rows.Count).End(xlUp).Offset(1)
should have been
Sheets("Sheet1").Cells(i, "A").EntireRow.Copy Destination:=Sheets("Sheet2").Range("A" & Sheets("Sheet2").Rows.Count).End(xlUp).Offset(1)
I see 2 errors.
First the Copy & Paste are two steps (2 commands). Second, if you use Cells, you have to give row and column as Number-Parameter. You have to change it to Range.
If Match1(i, 1) = "W" Then
Dim sourceRange As Range, destRange As Range
Set sourceRange = ws.Range("A" & i).EntireRow
' or Set sourceRange = ws.Cells(i, 1).EntireRow
sourceRange.Copy
Set destRange = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
destRange.PasteSpecial
End If
Related
I have the below code where in all other columns there is many populated rows, what I need this formula to do in column F is to find the first blank, then place the formula in it and fill it down to the last row.
What is currently happening is I have the range as F26 as this is usually first blank but this could change and I want the code to identify this and also have the formula dynamically know what row it is on, so for example if one month the first blank was in cell F30 the range would find it and the formula would start as E30*G30.
Any help would be greatly appreciated.
Private Sub calc()
Dim lastrow As Long
Dim rng As Range
lastrow = ThisWorkbook.Worksheets("Indiv").Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range("F26:F" & lastrow)
rng.Formula = "=Round((E26*G26),2)"
End Sub
You need to find the first free row in column F and then bulid your formula with this row:
Option Explicit
Private Sub calc()
Dim ws As Worksheet ' define worksheet
Set ws = ThisWorkbook.Worksheets("Indiv")
Dim LastRowA As Long ' find last used row in column A
LastRowA = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
Dim FirstFreeRowF As Long ' find first free row in column F (if first 2 rows have data)
FirstFreeRowF = ws.Cells(1, "F").End(xlDown).Row + 1
' fix issue if first or second row is empty
If FirstFreeRowF = ws.Rows.Count + 1 Then
If ws.Cells(1, "F").Value = vbNullString Then
FirstFreeRowF = 1
ElseIf ws.Cells(2, "F").Value = vbNullString Then
FirstFreeRowF = 2
End If
End If
' define range to add formula
Dim Rng As Range
Set Rng = ws.Range("F" & FirstFreeRowF, "F" & LastRowA)
' add formula
Rng.Formula = "=Round((E" & FirstFreeRowF & "*G" & FirstFreeRowF & "),2)"
End Sub
So this will consider F5 the first free row and fill in the formula in the selected range as seen below:
I think you should find the last used row in column F, so that you could know the next row is blank
lastrowF=sheets(sheetname).range("F" & rows.count).end(xlup).row
So the next row would be like
range("F" & lastrowF+1).formula="Round((E" & lastrowF+1 & "*G" & lastrowF+1 & ",2)"
I need to find the value of the last cell in column b of sheet1. This value will change weekly. I then want to take that value and find it in sheet2. Then I want to copy and paste all data below this found value to sheet3. I can't get past the first part with the following code:
Dim cell As Range
Dim rangefound As Integer
Dim lastRow As Long
lastRow = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
Set cell = Range("B:B").Find("rangefound")
rangefound = lastRow = Cells(lastRow, 2).Value
I've been struggling with the syntax for a month and really don't know what I'm doing.
try this
Sub test()
Dim cell As Range
Dim rangefound As Integer
Dim lastRow As Long
lastRow = Sheet1.Range("B" & Rows.Count).End(xlUp).Row
rangefound = Sheet1.Cells(lastRow, 2).Value
Set cell = Sheet2.Range("B:B").Find(rangefound)
MsgBox "The value was found in Sheet2!" & cell.Address
End Sub
The issues with your code were
using rangefound before it had a value, i.e. the order of the commands
using "rangefound" as a text instead of the variable
wrong syntax to assign a value to rangefound
not qualifying which sheet should be searched
Edit: To extend the code to copy the data below the found value to another sheet, use Offset to reference one row below. There are many different ways to do this, so using Offset is just one option.
Here is the complete code
Sub test()
Dim mycell As Range, RangeToCopy As Range
Dim rangefound As Integer
Dim lastRow As Long
lastRow = Sheet1.Range("B" & Rows.Count).End(xlUp).Row
rangefound = Sheet1.Cells(lastRow, 2).Value
' this is the cell with the found value
Set mycell = Sheet2.Range("B:B").Find(rangefound)
' now find the last row in Sheet2. We can use lastRow again,
' since it is no longer needed elsewhere
lastRow = Sheet2.Range("B" & Rows.Count).End(xlUp).Row
' set the range to copy to start one cell below rangefound
' to the end of the data in column B
Set RangeToCopy = Sheet2.Range(cell.Offset(1, 0), Sheet2.Cells(lastRow, "B"))
' copy the range and paste into Sheet3, starting at A1
RangeToCopy.Copy Sheet3.Range("A1")
End Sub
Note: I changed the variable name from "cell" to "mycell". It's better to use variable names that cannot be mistaken for Excel artifacts.
Another edit: If you need to paste into the next free row in Sheet3, use the techniques already established.
[...]
Set RangeToCopy = Sheet2.Range(cell.Offset(1, 0), Sheet2.Cells(lastRow, "B"))
' get the next available row in Sheet3
lastRow = Sheet3.Range("A" & Rows.Count).End(xlUp).Row + 1
' copy and paste
RangeToCopy.Copy Sheet3.Range("A" & lastRow)
[...]
Note that I'm using the same variable for three different purposes. If that is too confusing, create three distinct variables instead.
I have code that is not writing anything. I get a Match problem and a mismatch error in the code line below
rtar = Evaluate("=MATCH(" & ColLetter(rng1.Columns(2).Column) & rng1.Row & "&" & ColLetter(rng1.Columns(3).Column) & rng1.Row & "," & ColLetter(rng3.Columns(1).Column) & "1:" & ColLetter(rng3.Columns(1).Column) & last2 & "&" & ColLetter(rng3.Columns(3).Column) & "1:" & ColLetter(rng3.Columns(3).Column) & last2 & ",0)")
is highlighted in yellow.
To quickly explain the code and using my Excel image below the expected written result is the grey highlight in cells F8,G8,H8. The data that gets written into these cells only occurs when any set of numbers get written in the cell range, E6:E17 and only then. The data source is from cells M5 to O17. So as an example when cell E8 (3rd line down) has the 10-1 in it the code would search the data source (3rd line down) and write from the data source cells M8/N8/O8 to cells F8/G8/H8.
Please don’t suggest using a formula because in the arr1 and arr2 I will be using about 50 or more ranges. I only want to use this code and just need help with making the necessary offset and match adjustments.
Sub PlaceNumbers()
Dim c As Range, rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range
Dim last1 As Long, last2 As Long, rtar As Long, xtar As Long
Application.ScreenUpdating = False
With ActiveSheet
'create arrays
arr1 = Array(.Range("D5:H17"))
arr2 = Array(.Range("L5:O17)) '
'loop through arrays
For i = LBound(arr1) To UBound(arr1)
Set rng1 = arr1(i)
Set rng3 = arr2(i)
last1 = .Cells(.Rows.Count, ColLetter(rng1.Columns(1).Column)).End(xlUp).Row
last2 = .Cells(.Rows.Count, ColLetter(rng3.Columns(1).Column)).End(xlUp).Row
For Each c In rng1.Offset(1, 1).Resize(, 1)
If c <> "" Then
rtar = Evaluate("=MATCH(" & ColLetter(rng1.Columns(2).Column) & rng1.Row & "&" & ColLetter(rng1.Columns(3).Column) & rng1.Row & "," & ColLetter(rng3.Columns(1).Column) & "1:" & ColLetter(rng3.Columns(1).Column) & last2 & "&" & ColLetter(rng3.Columns(3).Column) & "1:" & ColLetter(rng3.Columns(3).Column) & last2 & ",0)")
xtar = Application.Match(c.Offset(0, -2), Range(ColLetter(rng3.Columns(1).Column) & rtar & ":" & ColLetter(rng3.Columns(1).Column) & last2), 0)
With Application.WorksheetFunction
c.Offset(0, 1) = .Index(Range(ColLetter(rng3.Columns(2).Column) & rtar & ":" & ColLetter(rng3.Columns(2).Column) & last2), xtar)
c.Offset(0, 2) = .Index(Range(ColLetter(rng3.Columns(3).Column) & rtar & ":" & ColLetter(rng3.Columns(3).Column) & last2), xtar)
c.Offset(0, 3) = .Index(Range(ColLetter(rng3.Columns(4).Column) & rtar & ":" & ColLetter(rng3.Columns(4).Column) & last2), xtar)
End With
End If
Next c
Next
End With
Application.ScreenUpdating = True
End Sub
Function ColLetter(Collet As Integer) As String
ColLetter = Split(Cells(1, Collet).Address, "$")(1)
End Function
Exec image
I think the existing answer (https://stackoverflow.com/a/55959955/8811778) is better (provided it does what you need it to) as it's shorter and easier to maintain/debug.
But I include an alternative, longer version below.
If the only logic/rule that results in values in M8:O8 being written to F8:H8 is "number of rows down" (i.e. 3 rows down), then I don't think you really need to use MATCH function.
If I understand correctly, you just want the Nth row of the source data, where N corresponds to the row of whatever non-empty cell (in the yellow cells) you're currently processing.
If you change your For each c in rng1.Offset(1, 1).Resize(, 1) to instead loop through the yellow cells one row at a time, you will have access to N (otherwise you need to do some row arithmetic: c.Row - first row of yellow cells + etc...).
Note that N is the variable rowIndexRelativeToRange in the code below and is relative to the range, not the worksheet (i.e. first row in the yellow cells, not first row of the worksheet).
Option Explicit
Sub PlaceNumbers()
Dim someSheet As Worksheet
Set someSheet = ActiveSheet ' Refer to this sheet by name if possible
With someSheet
Dim arr1 As Variant
arr1 = Array(.Range("D5:H17"))
Dim arr2 As Variant
arr2 = Array(.Range("L5:O17"))
End With
'Application.ScreenUpdating = False ' Uncomment when you think code is ready/working
Dim i As Long
Dim rng1 As Range, rng2 As Range
For i = LBound(arr1) To UBound(arr1)
Set rng1 = arr1(i)
Set rng2 = arr2(i)
' We have to resize the ranges (to get rid of the first row and first column)
' You may want to re-think whether the addresses you specify (when creating arr1 and arr2)
' even need to include the first row and first column (e.g. E6:H17 instead of D5:H17)
' -- or whether you could just ensure the address passed in already excludes the first row and first column.
' It depends on whether you need to use the first row and first column (somewhere else in your code).
' But precluding them (if possible) would shorten/simplify the procedure's logic.
Dim inputColumn As Range
Set inputColumn = rng1.Offset(1, 1).Resize(rng1.Rows.Count - 1, 1) ' -1 when resizing, otherwise you're looking at range E6:E18, not E6:E17
Dim dataSourceRange As Range
Set dataSourceRange = rng2.Offset(1, 1).Resize(rng2.Rows.Count - 1, rng2.Columns.Count - 1)
Dim rowIndexRelativeToRange As Long ' This index is 1-based and relative to the range, not the worksheet.
For rowIndexRelativeToRange = 1 To inputColumn.Rows.Count
If inputColumn(rowIndexRelativeToRange, 1) <> "" Then
inputColumn(rowIndexRelativeToRange, 1).Offset(0, 1).Resize(, 3).Value = dataSourceRange(rowIndexRelativeToRange, 1).Resize(, 3).Value
End If
Next rowIndexRelativeToRange
Next i
'Application.ScreenUpdating = True ' Uncomment when you think code is ready/working
End Sub
Putting this here because I don't want to put in a comment. Why can't you use a worksheet change event? You can set the target range to multiple ranges. Place this code in the worksheet containing the two areas you showed in your example. When the value in a cell changes it will automatically update the three cells to the right.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E6:E17")) Is Nothing Then
Range(Target.Address).Offset(, 1).Resize(1, 3).Value = Range(Target.Address).Offset(, 8).Resize(1, 3).Value
End If
End Sub
I pasted the entire macro below but this is the important part.
Range("B2:B10000").Value = Range("B2").Offset(-1, 1).Value
Range("D2:D10000").Value = Range("D2").Offset(-1, 1).Value
Range("F2:F10000").Value = Range("F2").Offset(-1, 1).Value
Range("H2:H10000").Value = Range("H2").Offset(-1, 1).Value
It works as is except it is creating unnecessary data because I don't know how to use variable names in a range object. My ranges are currently hard coded such as ("A1:A1000"), when I would like it to be something like ("A1:A & LastRow).
Also I have to explicitly call out column names to copy because the range won't accept a variable name like ("currentColumn & 1:currentColumn & LastRow).
Is there a way to use a varible name as part of a range object so we can use them in loops?
Sub prepareWorkbook()
Dim wbk As Workbook
Set wbk = ThisWorkbook
Dim wks As Worksheet
Set wks = wbk.ActiveSheet
Dim colx As Long
Dim ColumnCount As Long
Dim MySheetName As String
MySheetName = "Import"
LastRow = sht.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
'copy the worksheet and rename it before editing
Sheets(1).Copy After:=Sheets(1)
ActiveSheet.Name = MySheetName
'identify the Id column and move it to 1st column
Dim answer As Variant
Dim IdColumn As Range
answer = Application.InputBox("Enter Letter of Id column")
If Columns(answer).Column = 1 Then
Else
'cut Id column from current location and insert it at column index 1
Columns(answer).Select
Selection.Cut
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
End If
'trim the PartNumber column of any trailing spaces
Dim c As Range
For Each c In Range("A1:A10000")
c.Value = Application.Trim(Replace(c.Value, Chr(160), Chr(32)))
Next
' insert column every other column
' Loop through number of columns.
ColumnCount = Application.WorksheetFunction.CountA(Rows(1)) * 2
'step 2 means skip every other
For colx = 2 To ColumnCount Step 2
Columns(colx).Insert Shift:=xlToRight
Next
Range("B2:B10000").Value = Range("B2").Offset(-1, 1).Value
Range("D2:D10000").Value = Range("D2").Offset(-1, 1).Value
Range("F2:F10000").Value = Range("F2").Offset(-1, 1).Value
Range("H2:H10000").Value = Range("H2").Offset(-1, 1).Value
wks.Cells.EntireColumn.AutoFit
MsgBox ("Done")
End Sub
Assuming the you are running code in the Worksheet added here:
'copy the worksheet and rename it before editing
Sheets(1).Copy After:=Sheets(1)
ActiveSheet.Name = MySheetName
Also not sure what is the purpose of this code, nevertheless using it for the sample
Range("B2:B10000").Value = Range("B2").Offset(-1, 1).Value
Try this:
Dim lLastRow As Long
lLastRow = wbk.Worksheets(MySheetName).UsedRange.SpecialCells(xlLastCell).Row
Rem This updates only columns B, D, F & H - adjust as needed
For colx = 2 To 8 Step 2
With wbk.Worksheets(MySheetName)
Rem Creates Range as Range(Cells(rIni,cIini), Cells(rEnd,cEnd))
rem Corresponding code for "Range("B2:B10000").Value = Range("B2").Offset(-1, 1).Value" (see comment above)
Range(.Cells(2, colx), .Cells(lLastRow, colx)) = .Cells(2, colx).Offset(-1, 1).Value
End With: Next
Something like:
Dim LastRow As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("B2:B" & LastRow).Value = Range("B2").Offset(-1, 1).Value
Range("D2:D" & LastRow).Value = Range("D2").Offset(-1, 1).Value
Range("F2:F" & LastRow).Value = Range("F2").Offset(-1, 1).Value
Range("H2:H" & LastRow).Value = Range("H2").Offset(-1, 1).Value
Although this answer won't be applied to your situation, I feel like this could help answer some questions you have in there.
When specifying a range, you can separate the column (letter) and row (number) and use your own variables.
In a for loop, this could look like
for i = 1 to 100
Range("A" & i).Value = Range("A"&i).Offset(, 1).Value
next
You can also determine the number of the row of the selected cell using:
dim RowNb as long
RowNb = (ActiveCell.Row)
This also applies to columns, and can be used in a loop like I mentionned at the start.
The one thing that was conspicuous by its absence in your description was any mention of the nature of the data in the worksheet. You mentioned A1 briefly but your range value assignments started at row 2 so it may be inferred that row 1 contains column header labels.
Sub prepareWorkbook()
Dim wbk As Workbook, wks As Worksheet
Dim colx As Long
Dim lc As Long, lr As Long
Dim MySheetName As String
Set wbk = ThisWorkbook 'no idea what this does
Set wks = wbk.ActiveSheet 'no idea what this does
MySheetName = "Import"
'no idea what this does or what sht is
'LastRow = sht.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
'copy the worksheet and rename it before editing
Sheets(1).Copy After:=Sheets(1)
With Sheets(2)
.Name = MySheetName
If CBool(Application.CountIf(.Rows(1), "PartNumber")) Then
colx = Application.Match("PartNumber", .Rows(1), 0)
Else
colx = .Range(Application.InputBox("Enter Letter of Id column") & 1).Column
End If
If .Columns(colx).Column > 1 Then
'cut Id column from current location and insert it at column index 1
.Columns(colx).Cut
.Columns(1).Insert Shift:=xlToRight
End If
'quickest way to trim trailing spaces is with Text-to-Columns, Fixed Width
With .Columns(1)
.TextToColumns Destination:=.Cells(1), DataType:=xlFixedWidth, FieldInfo:=Array(0, 1)
End With
' insert column every other column (working backwards toward A1)
For lc = .Cells(1, Columns.Count).End(xlToLeft).Column To 2 Step -1
.Columns(lc).Insert Shift:=xlToRight
Next lc
For lc = (.Cells(1, Columns.Count).End(xlToLeft).Column - 1) To 2 Step -2
'let's put the row-by-row value in instead of a single value into all cells
lr = .Cells(Rows.Count, lc + 1).End(xlUp).Row
With .Cells(2, lc).Resize(lr - 1, 1)
.Cells = .Offset(-1, 1).Value
.EntireColumn.AutoFit
End With
Next lc
End With
Set wbk = Nothing
Set wks = Nothing
End Sub
Explanations as comments in code.
I have a text string that is using the ^ symbol as a delimiter.
I need to separate the text into new rows rather than new columns.
I need to create new rows to not overwrite the next line of data below it.
Is this possible without using a macro? I'm not against using one, I just wouldn't know where to start to write it.
Below is a pic of some sample data. The top part is how it's listed, and the bottom (in yellow) is how I would like it.
Using Excel 2010 on Windows 7 Pro.
Thanks to those that responded. A friend was able to help by providing the following code:
Sub Breakout()
Application.ScreenUpdating = False
LR = Cells(Rows.Count, 1).End(xlUp).Row
For r = LR To 2 Step -1
Set MyCell = Cells(r, 1)
Arry = Split(MyCell.Value, "^")
For c = 0 To UBound(Arry)
If c > 0 Then MyCell.Offset(c, 0).EntireRow.Insert
MyCell.Offset(c, 0) = Arry(c)
Next c
Next r
End Sub
Could try something like this:
Sub reArrange()
Dim inFirstRng As Range
Dim inRng As Range
Dim inCur As Variant
Dim outFirstRng As Range
Dim outCurRng As Range
Dim ws As Worksheet
'CHANGE ARGUMENT TO YOUR SHEET NAME
Set ws = Worksheets("Sheet2")
With ws
'CHANGE ARGUMENT TO WHATEVER THE FIRST CELL OR YOUR DATA INPUT IS IN COLUMN A
Set inFirstRng = .Range("A3")
Set inRng = .Range(inFirstRng, inFirstRng.End(xlDown))
'CHANGE ARGUMENT TO WHATEVER THE FIRST CELL OR YOUR DATA OUTPUT IS IN COLUMN A
Set outFirstRng = .Range("A9")
Set outCurRng = outFirstRng
End With
For Each cell In inRng.Cells
inCur = WorksheetFunction.Transpose(Split(cell.Value, "^"))
outCurRng.Resize(UBound(inCur), 1).Value = inCur
With ws
.Range("G" & outCurRng.Row & ":L" & outCurRng.Row).Value = _
.Range("G" & cell.Row & ":L" & cell.Row).Value
End With
Set outCurRng = outCurRng.Offset(UBound(inCur), 0)
Next cell
ws.Range("F" & outFirstRng.Row & ":F" & outCurRng.Row - 1).Value = 1
End Sub