Hey guys im trying to perform vlookup through cross-workbook. Im trying to write it this way.. but it seems not working using "x" and "x2"..
Folder = ActiveWorkbook.Path + "\"
Dim OptioneeManWb As Workbook
Dim TransOutWb As Workbook
Dim TransOutWs As Worksheet
Dim TermWb As Workbook
Dim TermWs As Worksheet
Set OptioneeManWb = Workbooks("optionee statement manual.xlsx")
Set TransOutWb = Workbooks.Open(Folder & "employee transfer out.xlsx")
Set x = TransOutWb.Worksheets("out").Range("A:C")
Set TermWb = Workbooks.Open(Folder & "employee terminated listing.xlsx")
Set x2 = TermWb.Worksheets("terminated").Range("A:C")
OptioneeManWb.Sheets("manual optionee stmt").Range("C6:C" & lastrow2).Formula = "=VLOOKUP(B:B,x,3,0)"
OptioneeManWb.Sheets("manual optionee stmt").Range("D6:D" & lastrow2).Formula = "=VLOOKUP(B:B,x2,3,0)"
OptioneeManWb.Sheets("manual optionee stmt").Range("C6:C" & lastrow2, "D6:D" & lastrow2).NumberFormat = "m/d/yyyy"
OptioneeManWb.Sheets("manual optionee stmt").Range("C:F").Copy
OptioneeManWb.Sheets("manual optionee stmt").Range("C:F").PasteSpecial xlPasteValues
TransOutWb.Close
TermWb.Close
VLOOKUP awaits an address of a range as second parameter.
.Formula = "=VLOOKUP(B:B," & x.Address(External:=True) & ",3,0)"
In your case "=VLOOKUP(B:B,x,3,0)" the x is not recognized as variable because it is within a string. Also you need to fill in the address in here (in external format so that the different workbook gets recognized too). Also see Range.Address Property (Excel) for info.
Also declare the variables to make sure the are of type range: Dim x As Range, x2 As Range at the top of your procedure.
OptioneeManWb.Sheets("manual optionee stmt").Range("C6:C" & lastrow2).Formula = "=VLOOKUP(B:B," & x.Address(External:=True) & ",3,0)"
OptioneeManWb.Sheets("manual optionee stmt").Range("D6:D" & lastrow2).Formula = "=VLOOKUP(B:B," & x2.Address(External:=True) & ",3,0)"
First You have to declare the variables x and x2 like this way :
Dim x as range
Dim x2 as range
Related
The background:
I have a workbook, Outline.xlsm, with a five-level hierarchy. In the first worksheet (WS1), the first three levels are described the first two columns, while the next two levels each have their own set of two columns:
In the second worksheet (WS2), there is no level 3, but everything else is the same. All cells are formatted as text.
I have some code that splits out each first-level section ("General thing") into its own workbook to allow users to make changes to the descriptions (and some other fields off to the right). The code in question then goes out and gets those new descriptions from each file and matches them to the ID number. Here is a sanitized version:
Option Explicit
Sub GatherData()
'Set up for speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Get files to be processed
Dim DataFolder As String
Dim DataFile As String
DataFolder = "\\SomeNetworkLocation"
DataFile = Dir(DataFolder & "\GeneralThing*.xlsx")
'Define ranges to search
Dim WS1_L1Rng As Range
Dim L2rng As Range
Dim L3rng As Range
Set WS1_L1Rng = Worksheets("WS1").Range("A2", "A" & Range("N2").End(xlDown).Row)
Set L2rng = Worksheets("WS1").Range("C2", "C" & Range("N2").End(xlDown).Row)
Set L3rng = Worksheets("WS1").Range("E2", "E" & Range("N2").End(xlDown).Row)
Dim WS2_L1Rng As Range
Dim WS2_L2Rng As Range
Set WS2_L1Rng = Worksheets("WS2").Range("A2", "A" & Range("K2").End(xlDown).Row)
Set WS2_L2Rng = Worksheets("WS2").Range("C2", "C" & Range("K2").End(xlDown).Row)
Dim MatchPos As Variant
Dim WS1_SearchRng As Range
Dim WS2_SearchRng As Range
Dim Cell As Range
'Find and copy data
Do While DataFile <> ""
Workbooks.Open Filename:=DataFolder & "\" & DataFile
With Workbooks(DataFile).Worksheets("WS1")
Set WS1_SearchRng = .Range("A2:" & "A" & .Range("A" & .Rows.Count).End(xlUp).Row & ",C2:" & "C" & .Range("C" & .Rows.Count).End(xlUp).Row & ",E2:" & "E" & .Range("E" & .Rows.Count).End(xlUp).Row)
End With
For Each Cell In WS1_SearchRng
If IsNumeric(Left(Cell.Value2, 2)) Then
Select Case Cell.Rows.OutlineLevel
Case Is < 4
MatchPos = Application.Match(Cell.Value2, WS1_L1Rng, 0)
Case 4
MatchPos = Application.Match(Cell.Value2, L2rng, 0)
Case 5
MatchPos = Application.Match(Cell.Value2, L3rng, 0)
End Select
If IsError(MatchPos) Then
Debug.Print "WS1 " & Cell.Value2
Else
MatchPos = MatchPos + 1
Workbooks(DataFile).Worksheets("WS1").Range("A" & Cell.Row, "L" & Cell.Row).Copy Destination:=Workbooks("Outline.xlsm").Worksheets("WS1").Range("A" & MatchPos, "L" & MatchPos)
End If
End If
DoEvents
Next Cell
If Workbooks(DataFile).Worksheets.Count > 1 Then
With Workbooks(DataFile).Worksheets("WS2")
Set WS2_SearchRng = .Range("A2:" & "A" & .Range("A" & .Rows.Count).End(xlUp).Row & ",C2:" & "C" & .Range("C" & .Rows.Count).End(xlUp).Row)
End With
For Each Cell In WS2_SearchRng
If IsNumeric(Left(Cell.Value2, 2)) Then
Select Case Cell.Rows.OutlineLevel
Case Is < 4
MatchPos = Application.Match(Cell.Value2, WS2_L1Rng, 0)
Case 4
MatchPos = Application.Match(Cell.Value2, WS2_L2Rng, 0)
End Select
If IsError(MatchPos) Then
Debug.Print "WS2 " & Cell.Value2
Else
MatchPos = MatchPos + 1
Workbooks(DataFile).Worksheets("WS2").Range("A" & Cell.Row, "I" & Cell.Row).Copy Destination:=Workbooks("Outline.xlsm").Worksheets("WS2").Range("A" & MatchPos, "I" & MatchPos)
End If
End If
DoEvents
Next Cell
End If
With Workbooks(DataFile)
.Save
.Close
End With
DataFile = Dir
Loop
'Return to regular configuration
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub
The problem:
Often, when I go to run this code, Application.Match throws an error when it tries to match to anything in WS2. It usually works fine if I just kill the execution and start over on the same data (sometimes it takes a few tries). Very rarely, it can't find anything in WS1 either; again, if I simply restart the execution it usually works just fine. Sometimes everything works great on the first try. Why does it not behave consistently?
Watch for implicit references to the active workbook/worksheet; what workbook/worksheet these instructions are referring to at run-time will depend on whatever workbook/worksheet is active at that time, and this is often responsible for such errors.
You can use Rubberduck (an open-source VBIDE add-in project I manage) to easily locate them for you (and other potential code issues).
Range("N2") in Worksheets("WS1").Range("A2", "A" & Range("N2").End(xlDown).Row) would be one. Worksheets used unqualified with a Workbook object would be another.
The solution is to explicitly qualify them with a Workbook or Worksheet object reference.
I have some macros that were working previously like:
Sub test()
'
' test Macro
'
Windows("_Macro_Duplicate Billing Templates.xltm").Activate
Src2 = Sheets("Parameters").Range("C12").Value
Workbooks.Open Filename:=Src2
End Sub
where I indicated "D:\Users\D801878\Int'l\Billing\2017_03\Billing Template_International_2017_03.xlsx" in cell C12
This was working in 2016 till now. Now I get the error that "D:\Users\D801878\Int'l\Billing\2017_03\Billing Template_International_2017_03.xlsx is not found."
Did anything change in terms of naming the filepath and filename?
I recommend to make like this:
I'm supposed the value 03 means the number of the month witch is march or mar, so:
Put in C12 the date mar.2017 and use the following code:
Dim y As Integer
Dim m As String
Dim ws As Worksheet
Dim link As String
Set ws = ThisWorkbook.Worksheets("Parameters")
y = Format(ws.Range("C12"), "yyyy")
m = Format(ws.Range("C12"), "mm")
link = "D:\Users\D801878\Int'l\Billing\" & y & "_" & m & "\Billing_Template_International_" & y & "_" & m & ".xlsx"
Workbooks.Open link
I want to copy a multiple cells in a row and paste it in a customized format.
For example:
Sheet1 --> value in cell(A1) = 10
value in cell(B1) = 20
value in cell(c1) = 30
Now copy the value of these cells and paste in a desired format like,
Cell(D1) value should be like this ->
f(10),b(20),x(30),total = 60
If not possible with copy/paste method is there any other method?
Thanks.
try this
With Worksheets("Sheet1")
.Range("D1") = "f(" & .Range("A1") & "),b(" & .Range("B1") & "),x(" & .Range("C1") & "),total = " & WorksheetFunction.Sum(.Range("A1:C1"))
End With
Here is a way to pass in a range of values and a target range for the output.
Sub CreateSummary()
Dim x() As Variant
Dim y As Range
x = Range("A1:C1")
Set y = Range("D1")
y = "f(" & x(1, 1) & "),b(" & x(1, 2) & "),x(" & _
x(1, 3) & "),total = " & WorksheetFunction.Sum(x)
End Sub
The result based on your example:
I have basic data with multiple excels which i need to sorted out the data based on the columns whereas the sorted data which has a unique values and these uniques values i put in array ,based on unique values a new workbook has to be create.
My problem:
When im excuting the macro sometimes its showing the error as
saveas method workbook class failed
How can i freeze a column?
My code:
sub marcel()
Dim sArray as string
Dim saArray as string
Dim Lastrow_Sub As Integer
Dim Lastrow_Aging As Integer
Dim Array_Sub As Variant
Dim Array_Sub_Aging As Variant
Dim rngFilter_Ws2 as range
Dim Sht6 as worksheet
Dim ColumnsToRemove2 as variant
Dim j2 as integer
Dim vItem2 as variant
Check_date = Format(Date, "yymm")
Sheets("q_Aging_base_data_incl_FDB").Columns("D:D").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=.Range("AY1"), Unique:=True
Lastrow_Aging = .Cells(.Rows.Count, "AY").End(xlUp).Row
Array_Sub_Aging = Range("AY2:AY" & Lastrow_Aging)
saArray = Array_Sub_Aging(m, 1)
Sheets("BASE qry_Inventory Activation b").Columns("H:H").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=.Range("AZ1"), Unique:=True
Lastrow_Sub = .Cells(.Rows.Count, "AZ").End(xlUp).Row
Array_Sub = Range("AZ2:AZ" & Lastrow_Sub)
sArray = Array_Sub(k, 1)
If sArray <> "APE" And saArray = "APE" Or sArray <> "XXUMA" And saArray = "XXUMA" Then
Dim NewBook_Sub_Aging As Workbook
Set NewBook_Sub_Aging = Workbooks.Add
With NewBook_Sub_Aging
.Title = saArray
NewBook_Sub_Aging.Worksheets("sheet1").Name = "Aging Inventory"
With rngFilter_Ws2
.AutoFilter Field:=4, Criteria1:=saArray, Operator:=xlFilterValues
.AutoFilter Field:=15, Criteria1:="reporting relevant Location", Operator:=xlFilterValues
.AutoFilter Field:=32, Criteria1:="<>(a) 0 - 360", Operator:=xlFilterValues
Set rngCopyAging_Sub = .SpecialCells(xlCellTypeVisible)
.AutoFilter ' Switch off AutoFilter
End With
rngCopyAging_Sub.Copy Destination:=NewBook_Sub_Aging.Worksheets("Aging Inventory").Cells(1, 1)
' Delete unwanted columns for subregions(APE and XXUMA) Aging
Set Sht6 = NewBook_Sub_Aging.Worksheets("Aging Inventory")
ColumnsToRemove2 = Array("Period", "AP_BU", "Subregion", "Strategic_BU", "Company_Code", "Company_name", "Plant_name", _
"Rep Location", "Storage_Location", "Storage_Location_name", "Date_last_goods_rec", "Stock_type", _
"Stock_type_name", "Kind_of_Material_name", "Supplier_name", "SummevonVEU_OIV1", "Days_since_production", _
"Remaining_shelf_life", "APO_Planner", "S_SCM_or_SVC")
For j2 = LBound(ColumnsToRemove2) To UBound(ColumnsToRemove2) Step 1
vItem6 = Application.Match(ColumnsToRemove2(j2), Sht6.Rows(1), 0)
Debug.Print vItem6
If IsNumeric(vItem6) Then
Sht6.Columns(vItem6).Delete
End If
Next j2
NewBook_Sub_Aging.Worksheets("Aging Inventory").Cells.EntireColumn.AutoFit
NewBook_Sub_Aging.Worksheets("Aging Inventory").Range("A1:P1").AutoFilter
NewBook_Sub_Aging.Worksheets("Aging Inventory").Range("A2:P2").Select
ActiveWindow.FreezePanes = True
.SaveAs Filename:="KPI" & " " & saArray & " " & Check_date & ".xlsx"
Application.DisplayAlerts = False
NewBook_Sub_Aging.Close
End With
End If
end sub
can anyone please help me out how to resolve this issue.
Both sArray and saArray don't seem to be defined as an actual array. Arrays are defined like this:
Dim myArray() as Integer
Any value assigned to any of the array positions need to be put in this way:
myArray(i) = 815 'i being a position, like 0 or 5
When you want to get the value held in a certain position, you would also reference that position. So, if I wanted the value in the 4th position of may array, I'd do
myArray(3) 'Arrays are zero-index based.
so when you do:
.SaveAs Filename:="KPI" & " " & saArray & " " & Check_date & ".xlsx"
You're giving the Filename parameter a variant variable that may contain nothing, so the line would throw an error.
I'll assume saArray and Check_date are global variables coming from a different Sub and the array is created and its values assigned over there; it would still throw an error, since you're giving the SaveAs module an array, and not a string. You HAVE to give it one of the values IN the array (And it has to be a string, since Filename has to be a string).
I am currently building a tool in order to take extracts from SAP and put them into a financial management tool (or Financial Tool). The tool successfully pulls actual data from a SAP CJ74 report, and normalizes the data.
I have a requirement to put a sumproduct function into a spreadsheet to extract data from a data source into the spreadsheet using names and dates as the product match. One sheet is for CAPEX spend, the other sheet is for OPEX spend. The two sheets are replicas of each other.
I attempted to write some code in order to execute my requirement below, but I am getting application defined or object defined error when executing the code. Could I get some assistance with either a better way of doing this, or correcting the errors below?
NOTE: the sheet where this code is running from is the 'Exporter tool'
Sub SumproductAlternative()
Dim Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
Dim Copyrange As Long, MaxRow As Long
Dim CapexPersonName As Range, CapexActualsDate As Range, CapexActualsCell As Range,
Dim OpexPersonName As Range, OpexActualsDate As Range, OpexActualsCell As Range
Dim OpexActualsDate As Range, CapexActualsDate as Range
Dim CapexPersonLookup As Range, OpexPersonLookup As Range
Set wb1 = Workbooks.Open("Financial Tool.xlsm")
Set wb2 = Workbooks.Open("Finance Extract.xlsm")
Set wb3 = Workbooks.Open("Exporter Tool.xlsm")
wb3.Worksheets("Config Sheet").Activate
Set CapexPersonName = ThisWorkbook.Sheets("Config Sheet").Range("A5:A" & LastRow)
Set CapexActualsDate = ThisWorkbook.Sheets("Config Sheet").Range("5:5" & LastColumn)
Set CapexSumRange = ThisWorkbook.Sheets("Capex Pivot").Range("A4").CurrentRegion
Set CapexPersonLookup = wb2.Sheets("Capex").Range("E2:E1300")
Set CapexActualsCell = wb2.Sheets("Capex").Range("5:5" & LastColumn)
Set OpexPersonName = ThisWorkbook.Sheets("Config Sheet").Range("A5:A" & LastRow)
Set OpexActualsDate = ThisWorkbook.Sheets("Config Sheet").Range("5:5" & LastColumn)
Set OpexSumRange = ThisWorkbook.Sheets("Capex Pivot").Range("A4").CurrentRegion
Set OpexPersonLookup = wb2.Sheets("Opex").Range("E2:E1300")
Set OpexActualsCell = wb2.Sheets("Opex").Range("c3:c" & LastRow)
wb1.Sheets("CAPEX").Select
With wb1.Sheets("Capex")
MaxRow = .Range("H528").CurrentRegion.rows.Count
For Copyrange = MaxRow To 528 Step -1
If .Cells(Copyrange).Interior.ColorIndex = 40 Then
.Cells(Copyrange).Formula = " = SUMPRODUCT((CapexPersonName" = "CapexPersonLookup)*(CapexActualsDate" = "CapexActualsCell),(CapexSumRange)"
End If
Next Copyrange
End With
MaxRow = 0
Copyrange = 0
wb1.Sheets("OPEX").Select
With wb1.Sheets("Opex")
MaxRow = .Range("H528").CurrentRegion.rows.Count
For Copyrange = MaxRow To 528 Step -1
If .Cells(Copyrange).Interior.ColorIndex = 40 Then
.Cells(Copyrange).Formula = " = SUMPRODUCT((OpexPersonName" = "OpexPersonLookup)*(OpexActualsDate" = "OpexActualsCell),(OpexSumRange)"
End If
Next Copyrange
End With
This bit concerns me:
Range("5:5" & LastColumn)
If you have say 4 for example as your last column, That range will be Rows 5 - 54 ALL COLUMNS because you are asking for "5:5" & 4 as a string that is "5:54", is this what you are expecting?
Also, where are LastRow and LastColumn being defined?
You assign formula in VBA in a form of string. So this code for example:
.Cells(Copyrange).Formula = "=SUMPRODUCT((CapexPersonName" = "CapexPersonLookup)*(CapexActualsDate" = "CapexActualsCell),(CapexSumRange)"
will error out since it is like a multiple Boolean expression (e.g. x = y = z) which is also not accepted in VBA.
To do what you want, try this:
Dim myformula As String
myformula = "=SUMPRODUCT((" & CapexPersonName.Address(, , , True) & "=" & _
CapexPersonLookup.Address(, , , True) & ")*(" & _
CapexActualsDate.Address(, , , True) & "=" & _
CapexActualsCell.Address(, , , True) & _
")," & CapexSumRange.Address(, , , True) & ")"
.Cells(Copyrange).Formula = myformula