Requirement: I need to copy 1 Column - Col G (need to determine the number of rows dynamically) from 1 Workbook to another.
Problem: Getting VBA Error:
Runtime Error: 9 - Subscript out of range Please help.
Sub Set_Open_ExistingWorkbook()
Dim wkb As Workbook
Set wkb = Workbooks.Open("C:\Users\me364167\Documents\Practice_OB_Status_Detailed_Report_Mainframe.xls")
'Set wkb = Workbooks.Open("C:\Users\me364167\Documents\Practice level_Opportunity Pipeline_Mainframe.xls")
Dim LastRow As Long
Dim Sheet1Data As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "G").End(xlUp).Row
End With
Workbooks("Practice_OB_Status_Detailed_Report_Mainframe.xls").Worksheets("OB_Status_Detailed_Report").Range(Cells(1, "G"), Cells(LastRow, "G")).Copy
Workbooks("OB Macro.xlsx").Worksheets("OB_Status_Detailed_Report").Range(Cells(1, "A"), Cells(LastRow, "A")).PasteSpecial
' Workbooks("Practice_OB_Status_Detailed_Report_Mainframe.xls").Worksheets("OB_Status_Detailed_Report").Range(Cells(1, "G"), Cells(LastRow, "G")).Copy
' Workbooks("OB Macro.xlsx").Worksheets("OB_Status_Detailed_Report").Range(Cells(1, "A"), Cells(LastRow, "A")).PasteSpecial Paste:=xlValues
wkb.Close
End Sub
This perhaps? Your ranges are not fully qualified and as Shai Rado says you are missing a PS paremeter.
Sub Set_Open_ExistingWorkbook()
Dim wkb As Workbook
Set wkb = Workbooks.Open("C:\Users\me364167\Documents\Practice_OB_Status_Detailed_Report_Mainframe.xls")
'Set wkb = Workbooks.Open("C:\Users\me364167\Documents\Practice level_Opportunity Pipeline_Mainframe.xls")
Dim LastRow As Long
Dim Sheet1Data As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "G").End(xlUp).Row
End With
With wkb.Worksheets("OB_Status_Detailed_Report")
.Range(.Cells(1, "G"), .Cells(LastRow, "G")).Copy
End With
With Workbooks("OB Macro.xlsx").Worksheets("OB_Status_Detailed_Report")
.Range(.Cells(1, "A"), .Cells(LastRow, "A")).PasteSpecial xlValues
End With
' Workbooks("Practice_OB_Status_Detailed_Report_Mainframe.xls").Worksheets("OB_Status_Detailed_Report").Range(Cells(1, "G"), Cells(LastRow, "G")).Copy
' Workbooks("OB Macro.xlsx").Worksheets("OB_Status_Detailed_Report").Range(Cells(1, "A"), Cells(LastRow, "A")).PasteSpecial Paste:=xlValues
wkb.Close
End Sub
Related
I have the following macro that will search for three different column headings, select the data under those headings and change the data from a currency format to a number format. The data is stored in Sheet 2 of my workbook and the macro works fine when I run it on it's own in this Sheet.
Sub ProjectFundingFormat()
'
Dim WS As Worksheet
Dim lastCol As Long, lastRow As Long, srcRow As Range
Dim found1 As Range, found2 As Range
Set WS = Workbooks("Workbook1.xlsm").Worksheets("Sheet2") 'Needs to be open
With WS
lastCol = .Cells(1, Columns.count).End(xlToLeft).Column
Set srcRow = .Range("A1", .Cells(1, lastCol))
Set found1 = srcRow.Find(What:="2018FundingLabor", LookAt:=xlWhole, MatchCase:=False)
If Not found1 Is Nothing Then
lastRow = .Cells(Rows.count, found1.Column).End(xlUp).Row
.Range(.Cells(2, found1.Column), .Cells(lastRow, found1.Column)).Select
Selection.NumberFormat = "0.00"
End If
End With
With WS
lastCol = .Cells(1, Columns.count).End(xlToLeft).Column
Set srcRow = .Range("A1", .Cells(1, lastCol))
Set found1 = srcRow.Find(What:="2018FundingNonlabor", LookAt:=xlWhole, MatchCase:=False)
If Not found1 Is Nothing Then
lastRow = .Cells(Rows.count, found1.Column).End(xlUp).Row
.Range(.Cells(2, found1.Column), .Cells(lastRow, found1.Column)).Select
Selection.NumberFormat = "0.00"
End If
End With
With WS
lastCol = .Cells(1, Columns.count).End(xlToLeft).Column
Set srcRow = .Range("A1", .Cells(1, lastCol))
Set found1 = srcRow.Find(What:="2018 Total Funding", LookAt:=xlWhole, MatchCase:=False)
If Not found1 Is Nothing Then
lastRow = .Cells(Rows.count, found1.Column).End(xlUp).Row
.Range(.Cells(2, found1.Column), .Cells(lastRow, found1.Column)).Select
Selection.NumberFormat = "0.00"
End If
End With
End Sub
I am wanting to combine this macro with another two so that I can go into Sheet 1, click a "run" button I have inserted and all my macros will run together to update my data. However, I am getting the error
Run time error 1004 - select method of range class failed
at the line
.Range(.Cells(2, found1.Column), .Cells(lastRow, found1.Column)).Select
Does anyone know what might be wrong with my code? I am confused since it works fine on its own, but won't run when combined with my other macros.
I am using the following macro to combine my two existing macros:
Sub ProjectUpdate()
Call ProjectName
Call ProjectFunding
Call ProjectFundingFormat
MsgBox "Done"
End Sub
You should really avoid to use .Select and .Activate at all! This slows down your code a lot and leads into many issues. It is a very bad practice. If you are interested in writing stable and good quality code I really recommend to read and follow: How to avoid using Select in Excel VBA
Your code can be reduced to the following:
Option Explicit
Public Sub ProjectFundingFormat()
Dim Ws As Worksheet
Set Ws = Workbooks("Workbook1.xlsm").Worksheets("Sheet2") 'Needs to be open
With Ws
Dim srcRow As Range
Set srcRow = .Range("A1", .Cells(1, .Columns.Count).End(xlToLeft))
Dim lastRow As Long
Dim found1 As Range
Set found1 = srcRow.Find(What:="2018FundingLabor", LookAt:=xlWhole, MatchCase:=False)
If Not found1 Is Nothing Then
lastRow = .Cells(.Rows.Count, found1.Column).End(xlUp).Row
.Range(.Cells(2, found1.Column), .Cells(lastRow, found1.Column)).NumberFormat = "0.00"
End If
Set found1 = srcRow.Find(What:="2018FundingNonlabor", LookAt:=xlWhole, MatchCase:=False)
If Not found1 Is Nothing Then
lastRow = .Cells(.Rows.Count, found1.Column).End(xlUp).Row
.Range(.Cells(2, found1.Column), .Cells(lastRow, found1.Column)).NumberFormat = "0.00"
End If
Set found1 = srcRow.Find(What:="2018 Total Funding", LookAt:=xlWhole, MatchCase:=False)
If Not found1 Is Nothing Then
lastRow = .Cells(.Rows.Count, found1.Column).End(xlUp).Row
.Range(.Cells(2, found1.Column), .Cells(lastRow, found1.Column)).NumberFormat = "0.00"
End If
End With
End Sub
Throw out unnecessary repeating With statements.
Last column number needs not to be determined you can use the last cell of row 1 direclty with .Cells(1, .Columns.Count).End(xlToLeft).
Throw out all .Select and .Activate.
Makes it much cleaner and more stable.
Or you even use an additional procedure to avoid repeating code at all, which is a good practice to not repeat code and better have procedures instead:
Option Explicit
Public Sub ProjectFundingFormat()
Dim Ws As Worksheet
Set Ws = Workbooks("Workbook1.xlsm").Worksheets("Sheet2") 'Needs to be open
With Ws
Dim srcRow As Range
Set srcRow = .Range("A1", .Cells(1, .Columns.Count).End(xlToLeft))
FindAndFormat srcRow, "2018FundingLabor"
FindAndFormat srcRow, "2018FundingNonlabor"
FindAndFormat srcRow, "2018 Total Funding"
End With
End Sub
Public Sub FindAndFormat(srcRow As Range, FindWhat As String)
With srcRow.Parent
Dim found1 As Range
Set found1 = srcRow.Find(What:=FindWhat, LookAt:=xlWhole, MatchCase:=False)
If Not found1 Is Nothing Then
Dim lastRow As Long
lastRow = .Cells(.Rows.Count, found1.Column).End(xlUp).Row
.Range(.Cells(2, found1.Column), .Cells(lastRow, found1.Column)).NumberFormat = "0.00"
End If
End With
End Sub
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
So i have to copy cells A1, B2 and C3 from one workbook and add a row in anotherworkbook(in the last line) with theses values in the columns A,B,C.
Here's what i got so far, i think i'm close but i cant finish.
I havo no idea whats wrong with this syntax "Set lastrow = wNew.Cells.(Rows.Count, "A").End(xlUp).Row + 1" that seens to be the problem
Sub Botão1_Clique()
Dim wks As Worksheet
Dim wNew As Worksheet
Dim y As Workbook
Dim lastrow As Long
Application.ScreenUpdating = False
Set wks = ActiveSheet
Set y = Workbooks.Open("Y:\teste.xlsx")
Set wNew = y.Sheets("GERAL")
Set lastrow = wNew.Cells.(Rows.Count, "A").End(xlUp).Row + 1
wks.Cells(1, 1).Copy
wNew.Cells(lastrow, 1).PasteSpecial Paste:=xlPasteValues
wks.Cells(2, 2).Copy
wNew.Cells(lastrow, 2).PasteSpecial Paste:=xlPasteValues
wks.Cells(3, 3).Copy
wNew.Cells(lastrow, 3).PasteSpecial Paste:=xlPasteValues
Application.ScreenUpdating = True
End Sub
I also would like to close the Y:\teste.xlsx workbook, and display a message saying "ROW ADDED"
You do a good job properly referencing Workbooks and Worksheets but also make sure you fully qualify Cells and Rows. They are properties of the worksheet object I.e. ThisWorkbook.Worksheets("..").Rows
Sub Botão1_Clique()
Dim wks As Worksheet, wNew As Worksheet
Dim y As Workbook
Dim lastrow As Long
Application.ScreenUpdating = False
Set wks = ActiveSheet
Set y = Workbooks.Open("Y:\teste.xlsx")
Set wNew = y.Sheets("GERAL")
With wNew
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Cells(lastrow, 1).Value = wks.Cells(1, 1)
.Cells(lastrow, 2).Value = wks.Cells(2, 2)
.Cells(lastrow, 3).Value = wks.Cells(3, 3)
End With
'extra code as requested
y.Close True 'save changes if TRUE
MsgBox "ROW ADDED"
Application.ScreenUpdating = True
End Sub
I have a macro that copies some columns from a BD Sheet and pastes in another sheet.
I've got this code working in Excel 2007, but I've encountered an issue Selecting a Sheet, then copy/paste in Excel 2010 and later. It seems the problem is not in my .Select. It appears to be in the PasteSpecial() that automatically selects the with Sheet() and executes other .copy() without going back to de previous sheet (the screen blinks every pasteSpecial) - I don't know if I was clear enough. [sometimes it works fine, especially using debugger]
Code
Const BD_SHEET As String = "Estrategia"
Const PRICE_SHEET As String = "Precos"
Public Sub Execute()
....
actualCalculate = Application.Calculation
Application.Calculation = xlCalculationManual
LoadPrices()
Application.Calculate
Application.Calculation = actualCalculate
End Sub
Private Sub LoadPrices()
Dim lastSheet As Worksheet
Set lastSheet = ActiveSheet
Sheets(BD_SHEET).Select
lastRow = [A1000000].End(xlUp).row
With Sheets(PRICE_SHEET)
Range(Cells(2, 2), Cells(lastRow, 2)).Copy
.[A2].PasteSpecial xlPasteValues '<---- Working
Range(Cells(2, 7), Cells(lastRow, 7)).Copy
.[B2].PasteSpecial xlPasteValues '<---- Working
Range(Cells(2, 9), Cells(lastRow, 10)).Copy '<---- Error!
.[C2].PasteSpecial xlPasteValues
Range(Cells(2, 12), Cells(lastRow, 12)).Copy '<---- Error!
.[E2].PasteSpecial xlPasteValues
End With
lastSheet.Select
End Sub
I can remove .Select and add Set theSheet = Sheets(BD_SHEET) but the code is going to be durty.
Exemple:
...
Set lastSheet = ActiveSheet
Set bdSheet = Sheets(BD_SHEET)
lastRow = [A1000000].End(xlUp).row
With Sheets(PRICE_SHEET)
bdSheet.Range(bdSheet.Cells(2, 2), bdSheet.Cells(lastRow, 2)).Copy
.[A2].PasteSpecial xlPasteValues
End With
...
but the code is going to be durty.
That is because you are doing it the wrong way
Instead of
With Sheets(PRICE_SHEET)
bdSheet.Range(bdSheet.Cells(2, 2), bdSheet.Cells(lastRow, 2)).Copy
.[A2].PasteSpecial xlPasteValues
End With
Do this
With bdSheet
.Range(.Cells(2, 2), .Cells(lastRow, 2)).Copy
Sheets(PRICE_SHEET).[A2].PasteSpecial xlPasteValues '<---- Working
End With
Also never use Hardcoded values to find the last row. You may see This on how to calculate the last row.
Also
Range1.Copy
Range2.PasteSpecial xlPasteValues
can be written as
Range2.Value = Range1.Value
Applying the above, I have re-written your code. Is this what you are trying? (Untested)
Private Sub LoadPrices()
Dim wsCopyFrm As Worksheet, wsCopyTo As Worksheet
Dim rng As Range
Dim lastRow As Long
Set wsCopyFrm = ThisWorkbook.Sheets(BD_SHEET)
Set wsCopyTo = ThisWorkbook.Sheets(PRICE_SHEET)
With wsCopyFrm
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
Set rng = .Range(.Cells(2, 2), .Cells(lastRow, 2))
wsCopyTo.Range("A2").Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
Set rng = .Range(.Cells(2, 7), .Cells(lastRow, 7))
wsCopyTo.Range("B2").Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
Set rng = .Range(.Cells(2, 9), .Cells(lastRow, 10))
wsCopyTo.Range("C2").Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
Set rng = .Range(.Cells(2, 12), .Cells(lastRow, 12))
wsCopyTo.Range("E2").Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
End With
End Sub
Sub BSRange()
Set ws1 = ThisWorkbook.Worksheets("Balance")
Set ws2 = ThisWorkbook.Worksheets("Summary")
Set ws3 = ThisWorkbook.Worksheets("Cash")
Dim Lastcol As Long
Dim Lastrow As Long
Dim colname As String
Lastcol = ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column
For i = 2 To Lastcol
With ws1
colname = Split(Cells(, i).Address, "$")(1)
Lastrow = .Cells(.Rows.Count, colname).End(xlUp).Row
End With
With ws3
Range(Cells(4, i), Cells(Lastrow, i)).Copy ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1, 1)
End With
With ws1
Range(Cells(4, i), Cells(Lastrow, i)).Copy ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
Next i
End Sub
The data does not copy and the compiler shows no error in the code. Also, when I try to get rid of With in the For loop, using SheetName in the prefix, then it gives me an error.
Try with these edits. I think you just need to be more careful about qualifying worksheets when you are working across multiple. For instance Cell() will call on the active worksheet, .Cells() will call on the workbook qualified in you With statement.
Sub BSRange()
Set ws1 = ThisWorkbook.Worksheets("Balance")
Set ws2 = ThisWorkbook.Worksheets("Summary")
Set ws3 = ThisWorkbook.Worksheets("Cash")
Dim Lastcol As Long
Dim Lastrow As Long
Dim colname As String
Lastcol = ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column
For i = 2 To Lastcol
With ws1
colname = Split(.Cells(, i).Address, "$")(1)
Lastrow = .Cells(.Rows.Count, colname).End(xlUp).Row
End With
With ws3
.Range(.Cells(4, i), .Cells(Lastrow, i)).Copy ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Offset(1, 1)
End With
With ws1
.Range(.Cells(4, i), .Cells(Lastrow, i)).Copy ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
Next i
End Sub