I'm having great problems getting this to work. Range Class Failed is the regular error, but essentially it just won't look to the other sheets. I've used the same style once before and it worked fine, I've tried for hours to troubleshoot but I'm running out of ideas. Would very much appreciate if someone could point me in the right direction.
I was expecting the xlookup to find the date in the other sheet (BondNAME) and return the cash flow associated with that date.
`Private Sub FillCashFlows()
Dim NumCols As Integer
Dim CashDate As Date
Dim BondNAME As String
Dim BondSheet As Worksheet
Dim DateRange As Range
Dim CashRange As Range
Dim NextCol As Integer
Worksheets("Cash Flow").Activate
Range("B2").Activate
NumCols = Range("B1", Range("B1").End(xlToRight)).Count - 1
For x = 1 To NumCols
BondNAME = ActiveCell.Offset(-1, 0)
ThisWorkbook.Worksheets(BondNAME).Activate
Set BondSheet = Worksheets(BondNAME)
Set CashRange = ThisWorkbook.Worksheets(BondNAME).Range("D2:D50")
Set DateRange = ThisWorkbook.Worksheets(BondNAME).Range("A2:A250")
Worksheets("Cash Flow").Activate
Range("B2").Activate
Do Until IsEmpty(ActiveCell.Offset(0, -1))
CashDate = ActiveCell.Offset(0, -NextCol - 1)
CashFlow = Application.XLookup(CashDate, DateRange, CashRange)
ActiveCell.Value = CashFlow
ActiveCell.Offset(1, 0).Activate
Loop
NextCol = NextCol + 1
Range("B2").Activate
ActiveCell.Offset(0, NextCol).Activate
Next
End Sub`
Related
I have created a spreadsheet with a sheet 1 input table, and want to transfer/copy that data into a sheet 2 log table. The input table on sheet 1 will have an inspection date and an inspection name cells. What I am having an issue with is that I can get the first line of the log to input, but the 2nd line I get a "Run0time error '1004': Application-defined or object defined error". Not sure what to look at from here.
Here's my code (I know, it's stiff rough and needs to be cleaned up):
Private Sub Add_Click()
Dim InspectionDate As String, InspectionName As String
Dim LastRow As Long
Worksheets("sheet1").Select
InspectionDate = Range("B4")
InspectionName = Range("B5")
Worksheets("sheet2").Select
Worksheets("sheet2").Range("B3").Select
If Worksheets("sheet2").Range("B3").Offset(1, 0) <> "" Then
Worksheets("sheet2").Range("B3").End(x1Down).Select
End If
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = InspectionDate
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = InspectionName
Worksheets("sheet1").Select
Worksheets("sheet1").Range("B4:B5").ClearContents
End Sub
Two main reasons why .Select, .Activate, Selection, Activecell, Activesheet, Activeworkbook, etc. should be avoided
The reasons are explained in the second answer on that page.
I have tested the code below and it works for me.
I'm autistic; so sometimes I appear to school others, when I'm only trying to help.
Option Explicit
Private Sub Add_Click()
Dim InspectionDate$, InspectionName$
Dim LastRow&
Dim WS As Worksheet, WS2 As Worksheet
Set WS = Worksheets("sheet1")
Set WS2 = Worksheets("sheet2")
InspectionDate = WS.Range("B4")
InspectionName = WS.Range("B5")
LastRow = 3
If WS2.Range("B" & LastRow + 1) <> "" Then
LastRow = WS2.Range("B" & Rows.count - 1).End(xlUp).Row
End If
WS2.Cells(LastRow + 1, 2) = InspectionDate
WS2.Cells(LastRow + 1, 3) = InspectionName
WS.Range("B4:B5").ClearContents
End Sub
I have two set of range named as LIST_KEY and LIST_CAT. In Column A, user will add some data which will contain one of the one of the text from LIST_KEY. I would like to get corresponding Category list from LIST_CAT depends upon the Key value
I am using below VBA code to achieve this. This include a Array formula.
Sub match()
Dim ss As Workbook
Dim test As Worksheet
Set ss = Excel.Workbooks("test.xlsm")
Set test = ss.Worksheets("Sheet1")
For i = 2 To test.Cells(Rows.Count, "A").End(xlUp).Row
Cells(i, "B").FormulaArray = "=INDEX(LIST_CAT,MATCH(TRUE,ISNUMBER(SEARCH(LIST_KEY,RC[-1])),0))"
Cells(i, "B").Formula = Cells(i, "B").Value
Next i
End Sub
This code works perfect if there is less data to fetch. But in my original use case, I will have around 8000 rows. Due to this large number of columns excel will go to not responding state after 2-3 minutes.
Instead of adding Array formula to column B, Is there anyway to convert that into VBA to run this faster. Sorry, I am new to this VBA stuff and dont have much experience
Try the following code, which uses arrays instead of worksheet formulas...
Option Explicit
Sub GetCategories()
Dim sourceWorkbook As Workbook
Set sourceWorkbook = Workbooks("test.xlsm")
Dim sourceWorksheet As Worksheet
Set sourceWorksheet = sourceWorkbook.Worksheets("Sheet1")
Dim lookupArray As Variant
lookupArray = sourceWorkbook.Names("LIST_KEY").RefersToRange.Value
Dim returnArray As Variant
returnArray = sourceWorkbook.Names("LIST_CAT").RefersToRange.Value
Dim tableArray As Variant
Dim lastRow As Long
With sourceWorksheet
lastRow = .Cells(.Rows.Count, "a").End(xlUp).Row
tableArray = .Range("A2:B" & lastRow).Value
End With
Dim desc As String
Dim i As Long
Dim j As Long
For i = LBound(tableArray, 1) To UBound(tableArray, 1)
desc = tableArray(i, 1)
For j = LBound(lookupArray, 1) To UBound(lookupArray, 1)
If InStr(1, desc, lookupArray(j, 1), vbTextCompare) > 0 Then
tableArray(i, 2) = returnArray(j, 1)
Exit For
End If
Next j
Next i
sourceWorksheet.Range("B2").Resize(UBound(tableArray, 1), 1).Value = Application.Index(tableArray, 0, 2)
End Sub
I'm trying to Extract Products Sales From Different Sheets depends on DATES( Between Two Dates), In the mainsheet, I have Two Columns : A for Dates; B for Sales Numbers. I'm new to VBA and trying to write code from learnt Youtube Videos, So far I can be able retrieve Only Column A values i.e, Only Dates, But I could not get the Sales values along with the Dates. I'm writing the Code Down here, Could you please check it once and let me know where and what exactly the mistake arise, your Suggestion Could helpful to me. Thank you in Advance. :)
Private Sub CommandButton1_Click()
Dim sh As Worksheet, Psh As String, x As Date, y As Date
Sheet8.Columns("A").NumberFormat = "m/d/yyyy"
Psh = Me.Shproducts ' Shproducts is Command Button Name
Set sh = Worksheets(Psh)
x = CDate(Me.TextBox1) ' Start Date
y = CDate(Me.TextBox2) ' End Date
Dim i As Long, Myrange As Range, Lastrow As Long
For i = 3 To sh.Range("F" & Rows.Count).End(xlUp).Row
If sh.Cells(i, 1) >= x And sh.Cells(i, 1) <= y Then
Sheet8.Range("A1000").End(xlUp).Offset(1, 0) = sh.Cells(i, 1)
Sheet8.Range("B1000").End(xlUp).Offset(1, 0) = sh.Cells(i, 2)
End If
Next i
End Sub
i haven't tested it, but you might want to do something like this. so this is based on your code:
Private Sub CommandButton1_Click()
Dim sh As Worksheet, Psh As String, x As Date, y As Date
Dim i As Long, Myrange As Range, Lastrow As Long
Dim destinationRange As Range, c As Range, sourceRange As Range
Dim counter As Long
Dim currentDate As Date, currentSales As Double
Sheet8.Columns("A").NumberFormat = "m/d/yyyy"
Psh = Me.Shproducts ' Shproducts is Command Button Name
Set sh = Worksheets(Psh)
x = CDate(Me.TextBox1) ' Start Date
y = CDate(Me.TextBox2) ' End Date
Set destinationRange = Sheet8.Range("A100000").End(xlUp).Offset(1, 0)
Set sourceRange = Range(sh.Range("F3"), sh.Range("F3").End(xlDown))
For Each c In sourceRange
currentDate = c.Value
currentSales = c.Offset(0, 1).Value
If currentDate >= x And currentDate <= y Then
destinationRange.Offset(counter, 0).Value = currentDate
destinationRange.Offset(counter, 1).Value = currentSales
counter = counter + 1
End If
Next i
End Sub
I'm trying to copy a range of cells down a specified number of times based on a cell value, and starting at the intersection of the active cell.
I've pored through pages of Stack Overflow issues.
Entire Sub with userform info.
Private Sub OKButton_Click()
Dim AppTab As String
Dim DDate As Date
Dim Rent As Long
Dim ActiveCost As Long
Dim Msg As String
AppTab = Application.Value
DDate = DispoDate.Value
Rent = RentPymt.Value
ActiveCost = Cost.Value
Msg = "Asset disposal date:"
Sheets(AppTab).Select
Range("A6:N11").Select
Selection.copy
Range("A9").Select
Selection.End(xlToRight).Offset(-3, 1).Select
ActiveSheet.Paste
ActiveCell.Offset(-5, 0).Select
ActiveCell.Value = Msg
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = DDate
ActiveCell.Offset(8, 5).Select
ActiveCell.Value = ActiveCost
ActiveCell.Offset(1, -5).Activate
Dim DataEntry As Worksheet, DataSht As Worksheet
Dim ItemName As Range, ItemCount As Range
Dim NRow As Long, TargetCell As Range
With ThisWorkbook
Set DataEntry = .ActiveSheet
Set DataSht = .ActiveSheet
End With
With DataEntry
Set ItemName = .Range("A11")
Set ItemCount = .Range("H3")
End With
NCol = ActiveCell.Column
With DataSht
NRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
'Set TargetCell = .Range("A" & NRow) 'This works
Set TargetCell = .Cells(NRow, NCol) 'Issue here
TargetCell.Resize(ItemCount.Value, 1).Value = ItemName.Value
End With
Range(Selection, Selection.End(xlToRight)).Select
Selection.copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Unload Me
End Sub
Getting
run-time 1004: Method 'Range' of object '_Worksheet'failed
I'm building amortization schedules for a portfolio of assets. When one disposes, I need to modify the amortization schedule for the new asset cost/rental payment, and track it at two different rates. Initiated by a userform where they enter the updated asset info.
I can run the original amortization schedule code, but I need the subsequent partial disposals to be dynamic as the portfolio could have hundreds of assets. (Let's not talk about how inefficient that is because the customer is always right and currently I'm doing it by copying and pasting.)
I've made some assumptions based on what you described so far, and what your code was doing already. Please let me know if it works as you need, or let me know and I can assist further.
See more comments in the code:
Private Sub OKButton_Click()
Dim AppTab As String
Dim DDate As String
Dim Rent As String 'this is never used
Dim ActiveCost As String
Dim Msg As String
AppTab = Application.Value 'This doesn't look quite right, it would return "Microsoft Excel" ... is that your sheet name?
DDate = DispoDate.Value
Rent = RentPymt.Value 'this is never used
ActiveCost = Cost.Value
Msg = "Asset disposal date:"
Dim DataEntry As Worksheet: Set DataEntry = ThisWorkbook.Sheets(AppTab) 'declare and set the worksheet to use - change as needed
Dim rngCopy As Range: Set rngCopy = DataEntry.Range("A6:N11") 'Set the range to copy - this could be determined more dynamically
Dim ItemCount As Long: ItemCount = DataEntry.Range("H3").Value 'set the number of rows to copy
With rngCopy
.Copy _
Destination:=.Offset(, .Columns.Count) 'Copy ("A6:N11") to ("O6:AB11")
.Offset(.Rows.Count - 1).Resize(1, .Columns.Count).Copy _
Destination:=.Offset(.Rows.Count, .Columns.Count).Resize(ItemCount, .Columns.Count) 'Copy the last line from above, to the number of the rows in ItemCount
End With
'Is not a good idea to use ActiveCell... better use a fixed range, or build some rules to determine your "active" cell (i.e.: use Find).
Dim rngActCell As Range: Set rngActCell = DataEntry.Range("P6") 'but if you insist in using ActiveCell, then use: Set rngActCell = Activecell
'Other details
With rngActCell
.Offset(-5, 0).Value = Msg 'P1
.Offset(-4, 0).Value = DDate 'P2
.Offset(4, 5).Value = ActiveCost 'U10
End With
Unload Me
End Sub
trying to work the VBA autofill function (end of code block) but I am running into an error everytime I try the execute the code. I get "Autofill method of Range class failed". Can someone help me out here? Searched google but nothing works. Probably overlooking something small. Thanks in advance for the help.
Sub UpdateLAB() '---> still need to work on this
'author: css
Dim SalesBook As Workbook
Dim ws2 As Worksheet
Dim wspath As String
Dim n As Integer
Dim FirstRow As Long
Dim LastRow As Long
Dim LastRow2 As Long
Dim sourceCol As Integer
Dim RefCellValue2 As String
Dim ps As String
Dim Platts As Workbook
Application.Calculation = xlCalculationAutomatic
Set SalesBook = Workbooks("ALamb.xlsm")
Set ws2 = SalesBook.Worksheets("US LAB Price")
wspath = "C:\Users\scullycs\Desktop\P&O\Platts Data\Platts 2016.xlsm"
FirstRow = ws2.Range("B4").Row
LastRow = ws2.Range("B4").End(xlDown).Row + 1
LastRow2 = ws2.Range("c4").End(xlDown).Row
sourceCol = 2 'refers to the column your data is in
For n = FirstRow To LastRow
RefCellValue2 = Cells(n, sourceCol).Value
If IsEmpty(RefCellValue2) Or RefCellValue2 = "" Then
Cells(n, sourceCol).Offset(0, -1).Copy
SalesBook.Worksheets("Control Page").Range("C8").PasteSpecial (xlPasteValues)
Else
End If
Next n
ps = SalesBook.Worksheets("Control Page").Range("C9").Text
Set Platts = Workbooks.Open(wspath)
Platts.Worksheets(ps).Activate
Range("A13").End(xlDown).Select
Selection.Offset(0, 11).Select
If Selection.Value = "" Then
MsgBox ("Platts data does not exist")
Platts.Close
Else
Selection.Copy
Set SalesBook = Workbooks("ALamb.xlsm")
SalesBook.Worksheets("US LAB Price").Range("b1").End(xlDown).Offset(1, 0).PasteSpecial (xlPasteValues)
'this is where I get the error
SalesBook.Worksheets("US LAB Price").Range("c4").AutoFill Destination:=Range("C4:C" & LastRow2), Type:=xlFillDefault
Platts.Close
End If
End Sub
Most probably your ranges are not overlapping OR range is too big. In case you want to refer, link.
Check the value of LastRow2.
Make sure the fill range is from same sheet to make them over lapping. To do so break your statement into simple steps. Later you can combine.
Will suggest to break down the statement into
Set SourceRange = SalesBook.Worksheets("US LAB Price").Range("C4:C4")
Set fillRange = SalesBook.Worksheets("US LAB Price").Range("C4:C" & LastRow2)
SourceRange.AutoFill Destination:=fillRange, Type:=xlFillDefault