I'm having trouble with something that seems very basic. My experience with vba is essentially nothing. I have a spreadsheet containing data imported from some csv files using a script I made. The script reads in the data then creates a master spreadsheet or overwrites the previous master spreadsheet. I would like to move this data one column over in the same script. The range of the data that needs to be moved changes every time the spreadsheet is updated as more data is added. I have included the following at the end of my code to do this, but I cannot get it to work.
Set myRange = Range(Cells(1, 1).Address(), Cells(lastRow, lastColumn).Address())
Range("myRange").Offset(,1)
What am I doing wrong?
Edit: Here is what I have now. I keep running into 'Run-time error 1004' on the 14th line.
Dim myRange As Range
Dim DefPath As String
Dim lastRow As Long
Dim lastColumn As Long
Dim lRow As Long
Dim lCol As Long
DefPath = Application.DefaultFilePath
Workbooks.Open Filename:=DefPath & "\SEM Master File"
lRow = Cells(Rows.Count, 1).End(xlUp).Row
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
Set myRange = Range(Cells(1, 1), Cells(lastRow, lastColumn))
myRange.Offset(, lastColumn).Value = myRange.Value
Second Edit: Here is what I have so far. It compiles and runs, but instead of moving everything over one column as I expected it to it makes a copy of the columns and puts it in the columns next to the data already in the spreadsheet.
Sub Offset_Data()
Dim myRange As Range
Dim DefPath As String
Dim lastRow As Long
Dim lastColumn As Long
DefPath = Application.DefaultFilePath
Workbooks.Open ("SEM Master File.xlsx")
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
lastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
Set myRange = Range(Cells(1, 1), Cells(lastRow, lastColumn))
myRange.Offset(, lastColumn).Value = myRange.Value
End Sub
Sub Offset_Data()
Dim myRange As Range
Dim DefPath As String
Dim lastRow As Long
Dim lastColumn As Long
DefPath = Application.DefaultFilePath
Workbooks.Open ("SEM Master File.xlsx")
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
lastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
Set myRange = Range(Cells(1, 1), Cells(lastRow, lastColumn))
myRange.Offset(, lastColumn).Value = myRange.Value
myRange.ClearContents
End Sub
Related
Looking to fill a variable range here. I can fill my formula to the right but when I want to fil it down, the formula disappears. I have also attached a picture and Column A starts with "Fund Name". Hope somebody can help me here thank you!! The link to the table is here. 1: https://i.stack.imgur.com/y1ZVH.png
Sub Six_Continue()
Dim Lastrow As Long
Dim lrow As Range
Dim Lastcol As Long
Dim lcol As Range
Lastrow = Cells(Rows.Count, 1).End(xlUp).Row
Set lrow = Range("C5:C" & Lastrow)
Lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
Set lcol = Range("C3", Cells(3, Lastcol))
Range("C5").FormulaArray = "=IFERROR(INDEX(DataTable[[Period]:[Period]],SMALL(IF(DataTable[[LP ID]:[LP ID]]=C$2,IF(DataTable[[Fund ID]:[Fund ID]]=$B5,ROW(DataTable[[Fund ID]:[Fund ID]])-ROW(DataTable[[Fund ID]:[Fund ID]]))),1)),"" "")"
Range("C5", lcol.Offset(2)).FillRight
Range("C5", lcol.Offset(2)).FillDown
End Sub
The code below worked for me (with a much simplified array formula).
Sub Six_Continue()
' 25 Jan 2018
Dim Rng As Range
Dim LastRow As Long
Dim LastClm As Long
With ActiveSheet ' better specify by name
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
LastClm = .Cells(1, .Columns.Count).End(xlToLeft).Column
Cells(5, 3).FormulaArray = "=IFERROR(INDEX(DataTable[[Period]:[Period]],SMALL(IF(DataTable[[LP ID]:[LP ID]]=C$2,IF(DataTable[[Fund ID]:[Fund ID]]=$B5,ROW(DataTable[[Fund ID]:[Fund ID]])-ROW(DataTable[[Fund ID]:[Fund ID]]))),1)),"" "")"
' .Cells(5, 3).FormulaArray = "= $a1 * $k1:$k5 * C$1"
Set Rng = Range(.Cells(5, 3), .Cells(5, LastClm))
Rng.FillRight
Set Rng = Range(.Cells(5, 3), .Cells(LastRow, LastClm))
Rng.FillDown
End With
End Sub
I have 7 productivity files which I need to copy the data from the sheet titled worktracker and paste these in the worktracker sheet in the masterfile, but I'm getting:
Run-time error 1004
Method Range of object_Worksheet failed.
Private Sub CommandButton1_Click()
Dim file As String
Dim myPath As String
Dim wb As Workbook
Dim rng As Range
Dim lastrow As Long, lastcolumn As Long
Dim wbMaster As Workbook
Set wbMaster = Workbooks("WorkTracker_Master.xlsm")
Set rng = wbMaster.Sheets("WorkTracker").Range("A4:W4")
myPath = "\\BMGSMP1012\GBDMC_Team$\GBDM_ContentManagement\+CM_Reports\Productivity Reports\FY18\"
file = Dir(myPath & "*.xls*")
While (file <> "")
Set wb = Workbooks.Open(myPath & file)
lastrow = wb.Worksheets("WorkTracker").Cells(Rows.Count, 1).End(xlUp).Row
lastcolumn = wb.Worksheets("WorkTracker").Cells(1, Columns.Count).End(xlToLeft).Column
Range(Cell(2, 1)(lastrow, lastcolumn)).Copy
Application.DisplayAlerts = False
ActiveWorkbook.Close
erow = WorkTracker.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination = Worksheets("WorkTracker").Range(Cells(erow, 1), Cells(erow, 4))
wb.Close SaveChanges:=True
Set wb = Nothing
file = Dir
Wend
Application.CutCopyMode = False
End Sub
You need to fully qualify all your objects, a comfortable and easy way, is to seperate each Workbook by using a nested With statement.
Also, as #YowE3K already mentioned in the comments above, you have a syntax error when defining the copied Range.
Try the code below, inside your While (file <> "") loop, after you Set wb = Workbooks.Open(myPath & file) :
With wb.Worksheets("WorkTracker")
lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
lastcolumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
.Range(.Cells(2, 1), .Cells(lastrow, lastcolumn)).Copy
End With
With wbMaster.Worksheets("WorkTracker")
' get first empty row in column "A"
erow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
' paste in the first empty row
.Range("A" & erow).PasteSpecial
End With
wb.Close SaveChanges:=True
Set wb = Nothing
I wrote a very simple macro, that opens another workbook and select range of data from this workbook.
However, I keep receiving this warning: object doesn't support this property or method
What is wrong?
Sub data()
Dim wb As Workbook
Dim ws As Worksheet
Dim filename As String
Dim lastrow As Integer
Dim lastcolumn As Integer
Dim range_to_copy As Range
'open workbook
filename = "C:\Users\mk\Desktop\sales report\Sales Report.xls"
Set wb = Workbooks.Open(filename)
Set ws = wb.Sheets("data")
lastcolumn = wb.ws.Cells(1, wb.ws.Columns.Count).End(xlToLeft).Column
lastrow = wb.ws.Cells(wb.ws.Roows.Count, 1).End(xlToLeft).Row
range_to_copy = Range("Cells(1,1):Cells(lastrow,lastcolumn)")
End sub
A number of things wrong.
Edit:
Dim lastrow As Integer
Dim lastcolumn As Integer
An Integer can store numbers up to 32,767. This won't be a problem for columns, but will throw an overflow error on the row number. It's better to use the Long data type - numbers up to 2,147,486,647.
The ws variable already references the workbook so you just need:
lastcolumn = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
lastrow = wb.ws.Cells(wb.ws.Roows.Count, 1).End(xlToLeft).Row
Rows only has one o in it.
Edit: xlToLeft looks at the right most cell and works to the left. As you're looking for rows you need to use xlUp which looks at the last cell and works up.
range_to_copy = Range("Cells(1,1):Cells(lastrow,lastcolumn)")
This is an object so you must Set it. The cells references are separated by a comma and should not be held as a string.
Sub data()
Dim wb As Workbook
Dim ws As Worksheet
Dim filename As String
Dim lastrow As Long
Dim lastcolumn As Long
Dim range_to_copy As Range
'open workbook
filename = "C:\Users\mk\Desktop\sales report\Sales Report.xls"
Set wb = Workbooks.Open(filename)
Set ws = wb.Sheets("data")
lastcolumn = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
lastrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
Set range_to_copy = ws.Range(ws.Cells(1, 1), ws.Cells(lastrow, lastcolumn))
End Sub
Note: Every range reference is preceded by the worksheet reference. Without this it will always look at the currently active sheet so if you aren't on the data sheet the following will fail as the second cell reference will look at the activesheet.
ws.Range(ws.Cells(1, 1), Cells(lastrow, lastcolumn))
It might be worth checking out the With....End With code block.
There are several errors in your code.
Try
lastcolumn = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
Set range_to_copy = Range(ws.Cells(1, 1), ws.Cells(lastRow, lastcolumn))
Once you defined and set your ws worksheet object, you don't need to refer to the wb object anymore, since your ws worksheet object is fully quallified with Sheets("data") in wb workbook.
Now, all you need to do is use the With statement, like in the code below:
Set ws = wb.Sheets("data")
With ws
lastcolumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set range_to_copy = .Range(.Cells(1, 1), .Cells(lastrow, lastcolumn))
End With
Since hours now I'm struggling with the same problem now...
I try to copy certain rows upon a condition in column A to an other Workbook. I don't get an error message, the code runs through, but nothing happens. Somehow it seems not to "see" the lines between Then and End If. If I run the code manually, the line directly jumps to End if and further repeats the loop.
Do you have any idea what could be wrong? - Thanks for any help!
This part of my code lookes like:
Dim LastRow As Integer, i As Integer
LastRow = Workbooks("Workb1.xlsx").Sheets("Sheet1").Cells(Rows.Count,"A").End(xlUp).Row
For i = 2 To LastRow
If Cells(i, 2).Value = "848" Then
Range(Cells(i, 2), Cells(i, 14)).Select
Selection.Copy
Workbooks("destination.xlsx").Activate
Worksheets("Sheet1").Select
Range("A63976").Paste
End If
Next i
After your first comments, the edited code now is:
Dim LastRow As Integer, i As Integer
Dim ws4 As Worksheet
Set ws4 = Workbooks("Workb1").Sheets("Sheet1")
LastRow = ws4.Cells(Rows.Count, "A").End(xlUp).Row
With ws4
For i = 1 To LastRow
If .Cells(i, 1).Value = 848 Then
Range(.Cells(i, 1)).Select
Selection.Copy
Workbooks("destination.xlsx").Activate
Worksheets("Sheet1").Select
Range("A63976").Paste
End If
Next i
End With
Ok, What I actually want to do:
Always copy from source to target sheet
First only for rows, which have a 848 in column A and paste them to target. So for all those rows, which have an 848 in column A:
Copy value in the column X in “source” --> Column Y in “target”
A --> A N-->B O-->C AM -->D AH -->G P-->I E-->J F-->K
Now, only consider those cells with a 618 in column A and copy/paste, again to the firs empty cell in this column (so after the rows with 848, now the target-sheet gets completed with the 618 cells.
A --> A N-->B O-->C AM -->D T -->G P-->I E-->J F-->K
Column E and F in the target: there are formula, which have to be elongated to the end of the column
I did change that much until now, that it's not even a working code anymore...
Private Sub CommandButton1_Click()
Dim LastRow As Integer, i As Integer, erow As Integer, LastRow2 As Integer
Dim ws4 As Worksheet
Set ws4 = Workbooks("macro_source").Sheets("Sheet1")
LastRow = ws4.Cells(Rows.Count, "A").End(xlUp).Row
With ws4
For i = 2 To LastRow
If .Cells(i, 1).Value = 848 Then
Workbooks("macro_source").Sheets("Sheet1").Activate
.Cells(i, 1).Copy
Set erow = Workbooks("destination.xlsx").Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 1).Select
ActiveSheet.Paste
End If
Next i
End With
End Sub
Maybe I have to add, that both files are pre-edited by the prior code, which I did not show here. And I still did not find out whether it's possible to upload the data as excel files...
Many thanks for your help again, I really stuck...
copying between books seems to go wrong fairly often even when what you have coded seems to logically be correct.
I have found in the past it's better to reference the sheet then use the reference and to use the with statement as it seems to handle range selections better
Some code below should work for you... (I have altered the paste to start at A1 and increment each time as the original code would overwrite each time it found a value - you should be able to edit to paste where you want)
Sub CopyToNewBook()
On Error Resume Next
Dim wbSrc As Workbook: Set wbSrc = Workbooks("Workb1.xlsx")
Dim wbDest As Workbook: Set wbDest = Workbooks("destination.xlsx")
If wbSrc Is Nothing Or wbDest Is Nothing Then
MsgBox "Please open both workbooks required"
Exit Sub
End If
On Error GoTo 0
Dim wsSrc As Worksheet: Set wsSrc = wbSrc.Sheets("Sheet1")
Dim wsDest As Worksheet: Set wsDest = wbDest.Sheets("Sheet1")
Dim LastRow As Long, i As Long, j As Long: j = 63976
With wsSrc
LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For i = 2 To LastRow
If .Cells(i, 1).Value = "848" Then
.Range(.Cells(i, 2), .Cells(i, 14)).Copy
wsDest.Range("A" & j).PasteSpecial xlPasteValues
j = j + 1
End If
Next i
End With
End Sub
UPDATE
For searching against multiple values
Sub CopyToNewBook()
On Error Resume Next
Dim wbSrc As Workbook: Set wbSrc = Workbooks("Workb1.xlsx")
Dim wbDest As Workbook: Set wbDest = Workbooks("destination.xlsx")
If wbSrc Is Nothing Or wbDest Is Nothing Then
MsgBox "Please open both workbooks required"
Exit Sub
End If
On Error GoTo 0
Dim SearchValues() As String: SearchValues = Split("848,618", ",")
Dim wsSrc As Worksheet: Set wsSrc = wbSrc.Sheets("Sheet1")
Dim wsDest As Worksheet: Set wsDest = wbDest.Sheets("Sheet1")
Dim LastRow As Long, i As Long, j As Long, z As Long: z = 63976
With wsSrc
LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For j = 0 To UBound(SearchValues)
For i = 2 To LastRow
If .Cells(i, 1).Value = SearchValues(j) Then
.Range(.Cells(i, 2), .Cells(i, 14)).Copy
wsDest.Range("A" & z).PasteSpecial xlPasteValues
z = z + 1
End If
Next i
Next j
End With
End Sub
To add to my comment
you're also counting the number of rows in column A and running the loop on column B. I'd also set your cells as it could be looking at the wrong sheet
Dim LastRow As Integer, i As Integer
Dim ws as worksheet
set ws = Workbooks("Workb1.xlsx").Sheets("Sheet1")
LastRow = ws.Cells(Rows.Count,"B").End(xlUp).Row
with ws
For i = 2 To LastRow
If .Cells(i, 2).Value = 848 Then
Range(.Cells(i, 2), .Cells(i, 14)).Select
Selection.Copy
Workbooks("destination.xlsx").Activate
Worksheets("Sheet1").Select
Range("A63976").Paste
End If
Next i
end with
Update:
you could simplify a lot of this
Dim LastRow As Integer, i As Integer
Dim ws as worksheet
set ws = Workbooks("Workb1.xlsx").Sheets("Sheet1")
LastRow = ws.Cells(Rows.Count,"B").End(xlUp).Row
with ws
For i = 2 To LastRow
If Trim(Val(.Cells(i, 1))) = 848 Then
Range(.Cells(i, 2)).Copy _
destination:=Workbooks("destination.xlsx") _
.Worksheets("Sheet1").Range("A63976").Paste
End If
Next i
end with
This code will work fine. Check your cell that has 848 in it manually and make sure it is an integer.
Try this:
Dim LastRow As Integer, i As Integer
Dim ws4 As Worksheet
Set ws4 = Workbooks("Workb1.xlsx").Sheets("Sheet1")
LastRow = ws4.Cells(Rows.Count, "A").End(xlUp).Row
With ws4.Columns(1)
For i = 1 To LastRow
If .Cells(i).Value = 848 Then
Range(.Cells(i, 2), .Cells(i, 14)).Select
Selection.Copy
Workbooks("destination.xlsx").Activate
Worksheets("Sheet1").Select
Range("A63976").Select
Selection.PasteSpecial
End If
Next i
End With
EDIT:
Ok, I'm sure this is frowned upon, but this is how I would have solved the issue. It's nothing close to pro-code, but it gets the work done.
Range("A1").Select
Do Until ActiveCell.Value = ""
If ActiveCell.Value = 848 Then
Range(ActiveCell.Offset(0, 1).Address(False, False), ActiveCell.Offset(0, 14).Address(False, False)).Select
Selection.Copy
Workbooks("destination.xlsx").Activate
Worksheets("Sheet1").Select
Range("A63976").Select
Selection.PasteSpecial
End If
ActiveCell.Offset(1, 0).Select
Loop
If this code does not work, there's something else that's fishy. The code needs to be executed in the worksheet containing the list, which should be placed in column A and contain no blanks.
You can always change which sheet is selected by adding code.
I have simple problem using a sort macro. When I import data from my other Workbook, the workbook run the macro below in SheetChange and receive the run-time error.
HOWEVER, it is working completely fine if I just run the macro when the Workbook is open.
I don´t know if I have to replace Range with ActiveWorkbook or something, but I think I have tried a lot of different stuff, still without luck :(
I want it to sort from column B, starting in row 13 and until the last row/column. It is dynamic, so it will change every time I import stuff.
Sub TESTSORT()
Dim startCol, myCol As String
Dim startRow, lastRow, lastCol As Long
Dim ws As Worksheet
Dim Rng, cell As Range
Application.ScreenUpdating = False
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
startCol = "A"
startRow = 13
lastRow = ws.Range(startCol & ws.Rows.Count).End(xlUp).Row
'lastCol = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column
lastCol = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
myCol = GetColumnLetter(lastCol)
Set Rng = ws.Range(startCol & startRow & ":" & myCol & lastRow)
' I GET THE ERROR HERE
Range(.Cells(13, 1), .Cells(lastRow, lastCol)).Sort key1:=Range("B13:B" & lastRow),
order1:=xlAscending, Header:=xlNo
End With
Application.ScreenUpdating = True
End Sub
Function GetColumnLetter(colNum As Long) As String
Dim vArr
vArr = Split(Cells(1, colNum).Address(True, False), "$")
GetColumnLetter = vArr(0)
End Function
It looks like you've got some issues inside your With statement... using Range instead of .Range in several places. I've tried to clean it up a bit below...
Sub TESTSORT()
Dim startCol, myCol As String
Dim startRow, lastRow, lastCol As Long
Dim ws, ws2 As Worksheet
Dim Rng, cell As Range
Set ws2 = ActiveSheet 'Preserves a reference to the active sheet as ws2
ThisWorkbook.Activate 'Makes this workbook the one that is displayed
Application.ScreenUpdating = False
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
startCol = "A"
startRow = 13
lastRow = .Range(startCol & .Rows.Count).End(xlUp).Row
'lastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
lastCol = ws2.UsedRange.Columns(ws2.UsedRange.Columns.Count).Column
myCol = GetColumnLetter(lastCol)
Set Rng = .Range(startCol & startRow & ":" & myCol & lastRow)
' I GET THE ERROR HERE
.Range(.Cells(13, 1), .Cells(lastRow, lastCol)).Sort key1:=.Range("B13:B" & lastRow),
order1:=xlAscending, Header:=xlNo
End With
Application.ScreenUpdating = True
End Sub
Function GetColumnLetter(colNum As Long) As String
Dim vArr
vArr = Split(Cells(1, colNum).Address(True, False), "$")
GetColumnLetter = vArr(0)
End Function