I wrote a simple VBA code to automate writing of Vlookup formulas. After testing the code I noticed that it is not working correctly when I select a Range from a different workbook. It creates Vlookup formula as intented but it does not switch to initial workbook. It stays focused on a Workbook which I used to select a range. As much as i noticed while debuging it references the correct workbook and sheet but it does not change focus for some reason.
If anyone has any ideas I would appreciate it. Thank you.
Sub vlookup_easy()
Dim Rng As Range
Dim shOriginal As String
Dim wbOriginal As String
Dim frmWS As String
Dim frmWb As String
Dim sRange As String
Dim iColumn As Integer
shOriginal = ActiveSheet.Name
wbOriginal = ActiveWorkbook.Name
Set Rng = Application.InputBox(Prompt:="Unestie Range za Vlookup formulu", Title:="Vlookup", Default:=Selection.Address, Type:=8)
sRange = Rng.Address
frmWS = Rng.Parent.Name
frmWb = Rng.Parent.Parent.Name
iColumn = Application.InputBox(Prompt:="Unestie indeks kolone za Vlookup formulu", Title:="Vlookup", Default:=2, Type:=1)
ActiveCell.Formula = "=VLOOKUP(" & ActiveCell.Offset(0, -1).Address(False, False) & ",'[" & frmWb & "]" & frmWS & "'!" & sRange & "," & iColumn & ",FALSE)"
Workbooks(wbOriginal).Sheets(shOriginal).Activate 'this part is not working correctly
End Sub
Related
I am trying to setup a macro to read a string of tab names (ProductTabs) and then search the workbook. Once the ProductTabs = the workbook tab name, it will clear the contents from 2 different ranges. I had it all manually coded, but its possible that additional tabs may be added. I'm stuck with getting the look to work correctly. I get a runtime 1004 - Application defined or object defined error, when it hits this line of code: Set ProductTabs = wb1.Sheets("tabNames").Cells(3, 2).Resize(1, lastcol - 1).SpecialCells(xlCellTypeConstants)
Sub ResetBudget()
Dim wb1 As Workbook
Dim addresses() As String
Dim addresses2() As String
Dim ProductTabs As Range, cell As Range
Dim i As Long, lastcol As Long
addresses = Strings.Split("B9,B12:B26,B32:B38,B42:B58,B62:B70,B73:B76,B83:B90", ",")
addresses2 = Strings.Split("I9,I12:I26,I32:I38,I42:I58,I62:I70,I73:I76,I83:I90", ",")
lastcol = wb1.Sheets("tabNames").Cells(3, Columns.Count).End(xlToLeft).Column
Set wb1 = ThisWorkbook
Set ProductTabs = wb1.Sheets("tabNames").Cells(3, 2).Resize(1, lastcol - 1).SpecialCells(xlCellTypeConstants)
For Each cell In ProductTabs
If CStr(wb1.Sheets("tabNames").Evaluate("ISREF('[" & wb1.Name & "]" & ProductTabs & "'!$A$1)")) = "True" Then
For i = 0 To UBound(addresses)
wb1.Sheets(ProductTabs).Range(addresses(i)).ClearContents
Next i
'wb1.Sheets("1061 ABAD-F").Range("B9,B12:B26,B32:B38,B42:B58,B62:B70,B73:B76,B83:B90").ClearContents
'wb1.Sheets("1061 ABAD-F").Range("I9,I12:I26,I32:I38,I42:I58,I62:I70,I73:I76,I83:I90").ClearContents
'wb1.Sheets("1062 TANF-F").Range("B9,B12:B26,B32:B38,B42:B58,B62:B70,B73:B76,B83:B90").ClearContents
'wb1.Sheets("1062 TANF-F").Range("I9,I12:I26,I32:I38,I42:I58,I62:I70,I73:I76,I83:I90").ClearContents
'wb1.Sheets("1063 Duals-F").Range("B9,B12:B26,B32:B38,B42:B58,B62:B70,B73:B76,B83:B90").ClearContents
'wb1.Sheets("1063 Duals-F").Range("I9,I12:I26,I32:I38,I42:I58,I62:I70,I73:I76,I83:I90").ClearContents
'wb1.Sheets("1064 CSHCS-F").Range("B9,B12:B26,B32:B38,B42:B58,B62:B70,B73:B76,B83:B90").ClearContents
'wb1.Sheets("1064 CSHCS-F").Range("I9,I12:I26,I32:I38,I42:I58,I62:I70,I73:I76,I83:I90").ClearContents
Else
Debug.Print "A tab " & ProductTabs & " was not found in " & wb1.Name
End If
Next cell
End Sub
I am trying to use Index and Match to lookup a value on another worksheet within the same workbook, but I keep getting an error returned. (error 2042) I know I can do this using a formula, (see pic) but I'd like to use code. Does anyone mind taking a look?
Dim WorkOrderDashboardCell As Range
Dim ProjectList As Worksheet
Dim ProjectNumber As String
Set ProjectList = Worksheets("Project List")
ProjectList.Activate
'We need to start by initializing values on the project list
With ProjectList
Dim LastRowProjectListSpreadsheet As Long
LastRowProjectListSpreadsheet = .Range("B" & Rows.Count).End(xlUp).Row
Dim ProjectListNumbers As Range
Set ProjectListNumbers = .Range("B2:B" & LastRowProjectListSpreadsheet)
Dim ProjectListProjectNumber As Integer
ProjectListProjectNumber = 2
End With
'Switch back to the Dashboard spreadsheet
DashBoard.Activate
Dim DashboardWorkOrderRange As Range
Set DashboardWorkOrderRange = DashBoard.Range("E17:E" & LastRowProjectListSpreadsheet)
For Each WorkOrderDashboardCell In Range("E17:E" & Rows.Count).End(xlUp).Row
ProjectNumber = Application.Index(ProjectListNumbers, Application.Match(WorkOrderDashboardCell, DashboardWorkOrderRange, 0))
Debug.Print ProjectNumber
Next
To use worksheet functions, use code like:
WorksheetFunction.Index
rather than:
Application.Index
You might also need to use the Address property of your ranges, like:
ProjectListNumbers.Address
I think this line here is incorrect:
For Each WorkOrderDashboardCell In Range("E17:E" & Rows.Count).End(xlUp).Row
You are trying to loop within a range, but this part of the aforementioned line returns a row number not a range of cells:
Range("E17:E" & Rows.Count).End(xlUp).Row
Change it to a range of cells.
Application.Match
In your code you are using
Set DashboardWorkOrderRange = DashBoard.Range("E17:E" & LastRowProjectListSpreadsheet) where LastRowProjectListSpreadsheet is possibly the wrong last row. Also you are using
For Each WorkOrderDashboardCell In Range("E17:E" & Rows.Count).End(xlUp).Row where Range("E17:E" & Rows.Count).End(xlUp).Row is a row (instead of a range). Finally you are using Application.Filter without testing the result of Application.Match. Some other issues are the unnecessary use of Activate and the use of long variable names the latter seriously affecting the readability of the code.
This is your code revised. When running it you will see that it makes little sense (mentioned in the comments).
I'm posting it for you only to maybe easier find out what you really want to do.
It is illustrating how the result of Application.Match should always be tested with IsNumeric (or IsError) and that you don't have to (in this case, should not) use Application.Index, but just the Cells property of the range object with the index returned by Application.Match, to return the desired value.
The Code
Option Explicit
Sub LittleSense()
Dim wb As Workbook: Set wb = ThisWorkbook ' Workbook containing this code.
Dim LastRow As Long
Dim plRng As Range
With wb.Worksheets("Project List")
LastRow = .Range("B" & .Rows.Count).End(xlUp).Row
Set plRng = .Range("B2:B" & LastRow)
End With
Dim dbRng As Range
With wb.Worksheet("Dashboard")
LastRow = .Range("E" & .Rows.Count).End(xlUp).Row
dbRng = .Range("E17:E" & LastRow)
End With
Dim cel As Range
Dim dbIndex As Variant
Dim plValue As Variant
For Each cel In dbRng.Cells
dbIndex = Application.Match(cel, dbRng, 0)
' You might as well do:
'dbIndex = dbIndex + 1
If IsNumeric(dbIndex) Then ' Not necessary: all values will be found.
plValue = plRng.Cells(dbIndex).Value
Debug.Print plValue & " (" & dbIndex & ")"
Else
' Not necessary: all values will be found.
Debug.Print "Not found " & "(""" & cel.Value & """)"
End If
Next cel
End Sub
I am interested in renaming my document's cell references to easily perform calculations in other sheets. In the below code I am trying to name cell Di to the concatenation of the text in Ci and the year. I am using the below code and getting an error:
Sub or Function Not Defined
Any ideas?
Sub Rename()
Dim ws As Worksheet
Set ws = ThisWorkbook.ActiveSheet
For i = 1 To 50
Dim rng As Range
Dim str As String
Set rng = Range("D" & i)
rng.Name = Range("C" & i) & "_" & "2019"
Next i
End Sub
Where is the error application-defined or object defined error coming from? It seems to be coming from the formula that I created. Please help. It really should not be this hard to write code in VBA but for some reason it is not working.
Sub get_levels()
Dim Count As Integer
Dim ticker As Variant
Dim lastRow As Long
Dim lastRowC As Long
Dim rng As Range
Dim current_input_position As Long
Dim sheet As String
Dim mula As String
Dim updatedTicker As String
Application.CutCopyMode = False
Count = 0
sheet = "Test_Sheet"
current_input_position = 2
lastRow = Cells(Rows.Count, "A").End(xlUp).row
Label:
Set rng = Range("A" & current_input_position & ":A" & lastRow)
For Each ticker In rng.Cells
lastRowC = Cells(Rows.Count, "C").End(xlUp).row
updatedTicker = ticker & " A" & " Mtge"
MsgBox updatedTicker
mula = "GCBDC 2018-1A A Mtge"
Range("E2").formula = "=BDS(" & mula & ",""MTGE_CMO_GROUP_LIST"",""Headers=N"")"
Next ticker
End Sub
Assuming your Bloomberg Add-In is functional (try calling BDS manually from a regular worksheet to check), I think you may need to change this line:
Range("E2").formula = "=BDS(" & mula & ",""MTGE_CMO_GROUP_LIST"",""Headers=N"")"
to
Range("E2").Formula = "=BDS(""" & mula & """,""MTGE_CMO_GROUP_LIST"",""Headers=N"")"
If your variable mula has spaces in it (and even if it doesn't), it might need to have " on either side.
(Also, most of your Range and Cells references have no worksheet or workbook specified -- meaning they'll refer to whatever workbook and worksheet happens to be active whilst the code is running. Broadly speaking, you don't want this, but that wasn't your question.)
I’m a complete newbie with VBA but have managed to cobble together the following which works fine for my worksheet where I have assigned the code to a command button. My problem is that my worksheet has in excess of 3000 rows and I don’t really want to create 3000 buttons.
My current thinking would be to have a script search a range of cells for a specific condition (i.e. TRUE) then run my original code as a subscript for each cell that matches the condition. I have tried creating a loop to match the condition being searched but don't know how to set the result(s) as an active cell.
Could anyone give me some pointer on how to achieve this or propose a better solution?
Thanks.
Sub Send_FWU_to_E_Drive()
Dim aTemp As String
Dim bTemp As String
Dim cTemp As String
Dim dTemp As String
Dim eTemp As String
Dim subdir As String
aTemp = "c:\test\"
bTemp = "E:\romdata\"
cTemp = ActiveCell.Offset(, -5) & ".fwu"
dTemp = ActiveWorkbook.path
eTemp = "\Firmware files"
subdir = "\Firmware Files\" & ActiveCell.Offset(, -5) & "\" & ActiveCell.Offset(, -5) & ".fwu"
MsgBox "The path of the active workbook is " & dTemp & subdir
If Dir(dTemp & subdir) = "" Then
MsgBox "Please check the file and ensure it is suitable for firmware updating with an SD card."
Exit Sub
End If
MsgBox "The file " & cTemp & " is being copied to " & bTemp
If Dir("e:\romdata", vbDirectory) = "" Then MkDir "E:\romdata"
If Dir(bTemp & "nul") = "" Then
MsgBox "The Destination Directory is missing, please ensure your SD Card is formatted, mapped as drive E and has a romdata directory."
Exit Sub
End If
FileCopy dTemp & subdir, bTemp & cTemp
End Sub
First modify your function to accept a range argument, which we'll call cell:
Sub Send_FWU_to_E_Drive(cell as Excel.Range)
Then change all the ActiveCell references in that Sub to cell.
The sub below loops through each cell in column B of the Active sheet and, if it's TRUE, calls your routine with the cell in column A of that row. So your offsets in the code in Send_FWU_to_E_Drive are all relative to the cell in column A. This code is untested, but should be close:
Sub Test
Dim Cell as Excel.Range
Dim LastRow as Long
With ActiveSheet
LastRow = .Range("A" & .Rows.Count).End(xlup).Row
For Each Cell in .Range("B2:B" & LastRow) 'Search for TRUE in column B
If Cell.Value = TRUE Then
Send_FWU_to_E_Drive cell.Offset(0,-1) 'Column A Cell
End If
Next Cell
End With
End Sub
EDIT: Per #Siddharth's suggestion, here's a Find/FindNext version:
Sub Test()
Dim cell As Excel.Range
Dim LastRow As Long
Dim SearchRange As Excel.Range
Dim FirstFindAddress As String
With ActiveSheet
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
Set SearchRange = .Range("B2:B" & LastRow) 'Search for TRUE in column B
Set cell = SearchRange.Find(what:=True, after:=SearchRange.Cells(1))
If Not cell Is Nothing Then
FirstFindAddress = cell.Address
Send_FWU_to_E_Drive cell.Offset(0, -1)
Do
Send_FWU_to_E_Drive cell.Offset(0, -1)
Set cell = SearchRange.FindNext(after:=cell)
Loop While Not cell Is Nothing And cell.Address <> FirstFindAddress
End If
End With
End Sub