Dim tableref As String
'get cluster number from cel 0,-2
cluster_num = ActiveCell.Offset(0, -2)
'path to named range in wb elementenbundel
tableref = "elementenbundel.xlsm!" & "table_" & cluster_num
'add colum tag to path
tablecol = "=" & tableref & "[Code]"
Set wb_1 = ThisWorkbook
'open wb elementenbundel
Set wb_2 = Workbooks.Open(wb_1.Path + "/elementenbundel.xlsm")
wb_1.Activate
'create defined name for the range
RangeName = "code_" & cluster_num
'MsgBox (RangeName)
'MsgBox (tablecol)
'if name not present, add named range referring to column of table in elementenbundel
If RangeExists(RangeName) Then
MsgBox (RangeName & " exists")
Else
MsgBox (RangeName & " does not exists")
ThisWorkbook.Names.Add Name:=RangeName, RefersTo:=tablecol
End If
'delete previous validation
ActiveCell.Validation.Delete
'insert validation depending on value in A15, B15 will hold "code_" & A15.value
'B15 will be used in the formula to populate the dropdown with the first column of the table in elementenbundel
ActiveCell.Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="=INDIRECT(B15)"
'look for data in elementenbundel to display in current table
Dim formula As String
formula = "=VLOOKUP(" & ActiveCell.Address & "," & tableref & ", 2)"
ActiveCell.Offset(0, 1).formula = formula
the above code works
I would like to change the VLOOKUP formula in such a way that users don't have to run the macro.
at the moment the macro grabs the value to put in tableref, but I prefer the formula takes over the value, so I am looking for something like this
formula = "=VLOOKUP(" & ActiveCell.Address & ",elementenbundel.xlsm!table_"& CONTENT OF CELL A15 & ", 2)"
the result will be that if A15 holds 1:
the dropdown will be populated with table_1 of elementenbundel
the VLOOKUP should be looking for the value in table_1, column 2 that
matches the selected value of the dropdown? thus adding A15.value to the formula
But I don't have a clue how to add this "cell.value" in this formula
Any help would be great!
Thanks in advance
formula = "=VLOOKUP(" & ActiveCell.Address & ",INDIRECT(""elementenbundel.xlsm!table_"" & A15), 2)
Related
I am trying to apply Vlookup on a filtered range with Variable Lookup Value(Changing according to the row number) and Variable Lookup Range(From a user browsed workbook). But, the formula bar after running the code shows the formula as :-
=IFERROR(VLOOKUP(#Sri Lanka15-#a_One-#Time Base Rent,'[C_Rent Report_25082020.xlsx]Sheet 1'!$J$1:$N$968,4,0)," ")
I am not sure where these "#" signs are coming from. The lookup value for this particular row is :-Sri Lanka15-a_One-Time Base Rent.
Below is the code:-
Dim LR As Long ' Defined as Last row in source file
Dim nlr As Long 'Defined as Last row in Macro Workbook where vlookup is applied
Dim Filename As String
Filename = Application.GetOpenFilename(FileFilter:="All Files(*.xls; *.xlsx; *.csv),*xls,*.xlsx, *csv", Title:="Select File To Be Opened")
Workbooks.Open Filename:=Filename
sourcefile = Dir(Filename)
With ActiveSheet
Range("A1:AQ" & nlr).AutoFilter Field:=25, Criteria1:="One-Time Base Rent"
For Each cell In Range("AA2:AA" & nlr).SpecialCells(xlCellTypeVisible)
lookupvalue = Cells(cell.Row, "Z").Value
cell.Formula = "=IFERROR(VLOOKUP(" & lookupvalue & ",'[" & sourcefile & "]Sheet 1'!$J$1:$N$" & LR & ",4,0),"" "")" ' The problem seems to be here in lookup value as rest are appearing as fine in formula
Next
End With
Since i need to apply subsequent filters after this. i would like to keep the lookup value as variable.
I have tried WorksheetFunction.Vlookup too, but i am not sure how to define the range from a file chosen by user in worksheetfunction
Any help is highly appreciated !!
Thanks
Please, try replacing of
cell.Formula = "=IFERROR(VLOOKUP(" & lookupvalue & ",'[" & sourcefile & "]Sheet 1'!$J$1:$N$" & LR & ",4,0),"" "")"
with
cell.Formula = "=IFERROR(VLOOKUP(" & cells(cell.Row, "Z").Address & ",'[" & sourceFile & "]Sheet 1'!$J$1:$N$" & lr & ",4,0),"" "")"
I have an Excel document containing 2 sheets, 1 import sheet and a data sheet. The dynamic dropdown in Column B of the Import sheet should be dependant on the value chosen in Column A of the import sheet.
However to find the corresponding "Series" I need to match the ID's from the data sheet. (Eicher ID should match the Series Parent ID; Column B and D)
Screenshots down below should explain it better;
I selected Eicher in User Sheet.A3, now I want to retrieve the ID from DataSheet Column B (mmcMake-24046283). With this I need to find all corresponding Series with the same Series Parent ID. So in this case my dropdown should have shown; Series Eicher, Series 2000, Series 3000, Series 300 and Series 400.
Ok, here is a code to insert the validation. Check the "setting variables" part to make sure every variable is properly set. Sorry for the quite complex variables names, but empty stomach makes hard to synthesize. :D
Sub SubDynamicDropdownGenerator()
'Declarations.
Dim StrDataSheetName As String
Dim StrImportSheetName As String
Dim StrImportColumnMake As String
Dim StrDataColumns As String
Dim StrDataColumnSeries As String
Dim StrDataColumnSeriesParentIDEntire As String
Dim BytDataColumnMakesIDInternalColumn As Byte
Dim RngCellWithDropDown As Range
'Setting variables.
StrDataSheetName = "Data" 'Insert here the name of the sheet with data
StrImportSheetName = "Import" 'Insert here the name of the sheet with the import (where the range with the dynamic drowpdown is)
StrImportColumnMake = "A" 'Insert here the letter of the column where labeled Make (according to your first picture it is A)
StrDataColumns = "A:E" 'Insert here the letters of the columns where the data are located in the data sheet (i guess they are A:E)
StrDataColumnSeries = "C" 'Insert here the letter of the column where the Series are located in the data sheet (i guess is the C column)
StrDataColumnSeriesParentIDEntire = "E:E" 'Insert here the address of the column where the Series Parent ID are located in the data sheet (i guess is the E column)
BytDataColumnMakesIDInternalColumn = 2 'Insert here the internal reference of the MakesID in the data sheet for the VLOOKUP functions (since it's in the second column, i set it to 2)
Set RngCellWithDropDown = Sheets(StrImportSheetName).Range("B3") 'Insert here the cell on witch you are going to apply the validation dropdown.
'Setting validation.
With RngCellWithDropDown.Validation
.Delete
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, _
Formula1:="=INDIRECT(""" & StrDataSheetName & "!" & StrDataColumnSeries & """&MATCH(VLOOKUP(" & StrImportColumnMake & RngCellWithDropDown.Row & "," & StrDataSheetName & "!" & StrDataColumns & "," & BytDataColumnMakesIDInternalColumn & ",FALSE)," & StrDataSheetName & "!" & StrDataColumnSeriesParentIDEntire & ",0)&"":" & StrDataColumnSeries & """&COUNTIF(" & StrDataSheetName & "!" & StrDataColumnSeriesParentIDEntire & ",VLOOKUP(" & StrImportColumnMake & RngCellWithDropDown.Row & "," & StrDataSheetName & "!" & StrDataColumns & "," & BytDataColumnMakesIDInternalColumn & ",FALSE))+MATCH(VLOOKUP(" & StrImportColumnMake & RngCellWithDropDown.Row & "," & StrDataSheetName & "!" & StrDataColumns & "," & BytDataColumnMakesIDInternalColumn & ",FALSE)," & StrDataSheetName & "!" & StrDataColumnSeriesParentIDEntire & ",0)-1)"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End Sub
Like i've said, it should work as long as the data stay sorted by Series Parent ID. Tell me if you need to appy it on multiple cells. I can edit the code accordingly. Also if you need any explanation on the really messy formula, just say please.
I have VBA code that copies data from one sheet into another sheet based on select criteria. The target sheet is a list of project names with columns of data that are pasted over.
Right now the code copies ALL data in the source column into the target cell. I would like the code to paste only the data that matches to the project name, and repeat down for each project - similar to a vlookup.
I'm new to VBA and don't know how to include a vlookup into the code. I have an Excel formula that retrieves the distinct values that match to the project name. I have tried to embed the formula into the code but receive a 'type mismatch' error and the formula is highlighted.
Is there a way for the code to loop through each project name and paste their distinct values?
Any help is appreciated!!
Excel formula
=IFERROR(LOOKUP(2, 1/((COUNTIF($J$8:J8,'Project plan'!D2:D91)=0)*($I$9='Project plan'!V2:V91)),'Project plan'!D2:D91),"") Source
Current code
Option Explicit
Sub Update_Market_Status()
'
' Update_Market_Status Macro
' Updates Status field in Executive Market Summary Report
'
Dim d As Long
Dim prev_acts As String
Dim next_acts As String
Dim ws As Object
Dim status_report As Object
Dim is_synced As Boolean
Dim sync_value As String
Dim lastRow As Long
Set ws = ThisWorkbook.Sheets("Project plan")
Set status_report = ThisWorkbook.Sheets("Status Report")
lastRow = ThisWorkbook.Sheets("Project plan").Cells(Rows.Count, "D").End(xlUp).Row + 1
On Error Resume Next
sync_value = ws.Range("U2").Value
If VBA.LCase(sync_value) = "y" Then
is_synced = True
Else
is_synced = False
End If
If is_synced = True Then
For d = 2 To lastRow
If LCase(ws.Range("N" & d).Value) = "y" Then
If LCase(ws.Range("T" & d).Value) = "c" Then
If prev_acts = vbNullString Then
prev_acts = "'- " & ws.Range("D" & d).Value
Else
prev_acts = prev_acts & vbLf & "- " & ws.Range("D" & d).Value
End If
ElseIf LCase(ws.Range("T" & d).Value) = "o" Or LCase(ws.Range("T" & d).Value) = vbNullString Then
If next_acts = vbNullString Then
next_acts = "'- " & ws.Range("D" & d).Value
Else
next_acts = next_acts & vbLf & "- " & ws.Range("D" & d).Value
End If
End If
End If
Next d
status_report.Range("E8").Value = prev_acts ' Previous Actions
status_report.Range("F8").Value = next_acts ' Next Actions
End If
End Sub
One way to approach this would be to have the VBA script insert the lookup formula you gave into the cells of the new sheet, then select and copy those cells and paste them as values only.
A similar approach would be to use the WorksheetFunctions object to call the functions of the formula within VBA, then write the resulting value into your sheet.
Either of these approaches avoids recreating the worksheet functions in VBA code.
I am trying to clean an excel dataset provided to me using VBA in the most efficient way possible. I want to compare row values (# may vary) of 3 columns within a worksheet range, if the row values are the same for all 3 columns, then i want the values of the same rows but different columns copied into one cell.
Sample Set: red should be copied into one cell:
Expectation with black removed and red in one cell
Ultimate Want
Before/ After Expectation
In the future, SO questions should be about specific issues you are having, not a general question.
Here is a VBA function that will:
Go through each cell, until it finds an empty cell. We will assume once an empty cell is found we are at the end of your data set.
Check if any of the first three columns have changed their data from the previous cell. If they have, this is our new 'working row'. The row where we will consolidate your dataset into.
For each row, add its value from the data set column to the 'working row', unless it already exists in that row.
Once finished, go back and delete empty cells.
Here's the subroutine:
Sub clean_dataset()
Dim sh As Worksheet
Dim rw As Range
Dim workingRow As Integer
Dim col1Value As String
Dim col2Value As String
Dim col3Value As String
Dim rowCount As Integer
workingRow = 1
'Iterate through all rows on the sheet. Stop if we get to an empty row.
Set sh = ActiveSheet
For Each rw In sh.Rows
' Exit if we get to an emptry row.
If sh.Cells(rw.Row, 1).Value = "" Then
Exit For
End If
' Check if our three columns to watch have changed value. If they have, we should be in a new 'working row'
If rw.Row > 1 Then
If (Range("A" & rw.Row).Value <> Range("A" & rw.Row - 1).Value) Or (Range("B" & rw.Row).Value <> Range("B" & rw.Row - 1).Value) Or (Range("C" & rw.Row).Value <> Range("C" & rw.Row - 1).Value) Then
workingRow = rw.Row
End If
End If
' Get the values in the current row from the dataset we are trying to consolidate.
col1Value = Range("D" & rw.Row).Value
col2Value = Range("E" & rw.Row).Value
col3Value = Range("F" & rw.Row).Value
' Add the values to the working row cells, if they do not already exist
If InStr(Range("D" & workingRow).Value, col1Value) = 0 Then
Range("D" & workingRow) = Range("D" & workingRow).Value & vbLf & col1Value
End If
If InStr(Range("E" & workingRow).Value, col2Value) = 0 Then
Range("E" & workingRow) = Range("E" & workingRow).Value & vbLf & col2Value
End If
If InStr(Range("F" & workingRow).Value, col3Value) = 0 Then
Range("F" & workingRow) = Range("F" & workingRow).Value & vbLf & col3Value
End If
' As long as we are not in the working row, delete the values
If rw.Row <> workingRow Then
Range("D" & rw.Row) = vbNullString
Range("E" & rw.Row) = vbNullString
Range("F" & rw.Row) = vbNullString
End If
rowCount = rw.Row
Next rw
' End of for each
' Go back through, and delete any rows that do not have values in column D
For iter = rowCount To 1 Step -1
' If all three columns are blank, delete the row.
If Range("D" & iter).Value = vbNullString Then
sh.Rows(iter).Delete
End If
Next
End Sub
Hope this helps.
After quite a bit of searching I was able to finally find this very applicable post as my issue is similar to the OP.
I'm working with three sheets where Sheet 1 is the source, Sheet 2 is a check sheet and Sheet 3 is where I would be pasting/cleaning up my data from Sheet 2.
In Sheet1, I copy the value in Col C and filter it in Sheet2 - Col C and for each company in Col J, I need to check the volume in Col K and if volume is >/= 1, the row needs to be copy/pasted into Sheet 3 while consolidating the corresponding unique values in each cell of the row and removing duplicates and summing the values in col K. The third sheet is the expected sheet. Thanks for your help if possible.
Im trying to create a code which will allow me to pull the average of 6 rows from a sheet called 'Raw Data' and dump it into a cell in a different worksheet, and then pull the average of the next 6 rows from 'Raw Data' and so on.
E.G. average('RawData'! A1:A6) in a new sheet A1
then
average('Raw Data'! A7:A12) In new sheet A2
etc.
So far I have managed to make the code loop in a way that I want however Im having trouble writing the actual formula in new sheet A1 and A2.
so far I have tried:
Dim address13 As String
address13 = "'Raw Data'" & "!" & Cells(start_row, RPM1300).Address & ":" & _
Cells(end_row, RPM1300).Address
ActiveCell.Offset(0, -4).Select
'1300
ActiveCell.Formula = "=Average(""" & address13 & """)"
However this returns the correct formula but with "" around it - rendering it useless.
I have also tried:
Sheets("Raw Data").Select
Dim address9 As Range
Set address9 = Range(Cells(start_row, RPM900).Address(), Cells(end_row, RPM900).Address())
Sheets("New Sheet").Select
rCell.Activate
ActiveCell.Offset(0, -5).Select
ActiveCell.Formula = "=Average(address9)"
However this just returns the name of the variable address9 in the formula rather than the actual range.
Note that RPM1300, RPM900, start_row, end_row and rCell are all variables in order for the code to loop and paste into the correct places.
Any help would be greatly apreciated
Try replacing your line:
ActiveCell.Formula = "=Average(""" & address13 & """)"
With:
ActiveCell.Formula = "=AVERAGE(" & address13 & ")"
The reason: the variable address13 is already defined as a String, that's why you don't need the extra " inside the brackets.
Code (use your first method:)
Dim address13 As String
address13 = "'Raw Data'!" & Cells(start_row, RPM1300).Address & ":" & _
Cells(end_row, RPM1300).Address
ActiveCell.Offset(0, -4).Select
ActiveCell.Formula = "=AVERAGE(" & address13 & ")"
Note: Try avoid using Select and ActiveCell , instead use referenced Ranges and Worksheets.
For instance, let's say you start from Cell A1, and you want this formula to be in Cell A5, you can use:
Range("A1").Offset(4, 0).Formula = "=AVERAGE(" & address13 & ")"
It is probably a bug in your version of Excel. Instead of
ActiveCell.Formula = "=Average(""" & address13 & """)"
try using
ActiveCell.Formula = '=Average("' & address13 & '")'
(single quotes around strings with double quotes and using only 1 double quote then).
Instead of
ActiveCell.Formula = "=Average(""" & address13 & """)"
Try
ActiveCell.Formula = "=Average("& chr(34) & address13 & chr(34) & ")"
At least here chr(34) returns the quotes you want. This may be tweaked if needed. Just change the number inside the ( )
Try using this:
Sub CellValue()
Dim adr As String
Dim sht As String
sht = "'Raw Data'"
adr = "A1:A3"
ActiveCell.Formula = "=AVERAGE(" & sht & "!" & adr & ")"
End Sub
Hope it helps :)
This formula will give you the same result and you'd be able to autofill it by dragging the cell handle.
=AVERAGE(OFFSET('Raw Data'!$A$2,ROW(A1)*6-7,0,6,1))
Filling in both formulas
Sub FillFormulas()
Const BASE_FORMULA = "=AVERAGE('Raw Data'!#Address)"
Dim lastRow As Long, x As Long
Dim Formulas
With Worksheets("Raw Data")
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row / 6
End With
ReDim Formulas(1 To lastRow, 1 To 1)
With Worksheets("New Sheet")
For x = 1 To lastRow
Formulas(x, 1) = Replace(BASE_FORMULA, "#Address", .Cells((x * 6) - 5, 1).Resize(6).Address)
Next
.Range("A1").Resize(lastRow).Formula = Formulas
.Range("C1").Resize(lastRow).Formula = "=AVERAGE(OFFSET('Raw Data'!$A$2,ROW(A1)*6-7,0,6,1))"
End With
End Sub