i have a problem with my macro. I know its alot of code (sry for that) but i think it could be helpfull. So the basic thing i want to do is, take the value of the combobox and search for it in another worksheet to get the price written in the next column.
easy so far, but the name im searching for is not unique in the database. the one im searching for is only defined by beeing part of the correct named range (i.e. EngineMercedesDiesel)
Function getprice(Matrix As Range, name As String)
Dim i As Integer
Dim row As Variant
Dim col As Variant
Dim price As Variant
'loop to finde inside the range the name im looking for
For i = 1 To Matrix.Rows.Count
If Matrix.Cells(i, 1).Value = name Then
row = Matrix.Cells(i, 1).Address(RowAbsolute:=True)
col = Matrix.Cells(i, 1).Address(ColumnAbsolute:=True)
price = Tabelle2.Cells(row, col + 1).Value
Exit For
Next
getprice = price
End Function
Private Sub cbschaltung_Change()
Dim go As Range
Dim handle As String
'from here it builds the name i.e. EngineMercedesDiesel an there is a Named range with the same titel outside VBA
teil = Range("A4").Value
hersteller = Range("B3").Value
handle = cbschaltung.Value
If checkboxel.Value = True Then
c = checkboxel.Caption
Set go = teil & hersteller & c 'storing to the variable go, here ocures the error
Tabelle3.Range("C4").Value = getprice(go, handle)
ElseIf checkboxmech.Value = True Then
c = checkboxmech.Caption
Set go = teil & hersteller & c
Tabelle3.Range("C4").Value = getprice(go, handle)
End If
End Sub
I hop you can help me and (hopefully) you have a easy answer for me
ok i did it finally !
ElseIf checkboxmech.Value = True Then
c = checkboxmech.Caption
mname = teil & hersteller & c
Set go = Worksheets("Gruppendatenbank").Range(mname)
Tabelle3.Range("C4").Value = getprice(go, handle)
it was immportant to define mname as variant datatype and define also the worksheet of my range.
thank for the help
statusupdate: solved !
Related
i need to set a variable name that changes within a loop. Please look below:
The result i need is:
Vari1 = 1
Vari2 = 2
Vari3 = 3
What i tried:
for i = 1 to 3
Vari(i) = i ' (Vari & i) also doesnt work
next i
Any thoughts?
Thanks
First return the dynamic i from your code somehow (simplified below) then resize your array:
Sub Test()
Dim Vari() As Long
Dim i As Long, x As Long
'Get value of i somehow
i = 3
ReDim Vari(1 To i)
For x = 1 To i
Vari(x) = x
Next x
End Sub
Or populate a Variant data type array directly through Evaluate:
Sub Test()
Dim Vari() As Variant
Dim i As Long
'Get value of i somehow
i = 3
Vari = Evaluate("TRANSPOSE(ROW(1:" & i & "))")
End Sub
I have a excel file which looks like below:
Now, I've created a list in cell "L2" using the values in the name column and added a button "Find".
What I'm trying to do is when I click the button after selecting a value in "L2", it will give me the respective values of Name, ID, DOB, Email from the table "A4:E12" in the cells "I6:L6" and if "I6:L6" has values then it will move to "I7:L7" and so on every time I hit the button.
Here is the code I've done:
Sub getValues()
Range("I6").Select
ActiveCell.Formula = "=VLOOKUP($L$2,$A$5:$E$12,{1,2,4,5},0)"
Range("I6").AutoFill Destination:=Range("I6:L6"), Type:=xlFillDefault
Range("I6:L6").Select
Range("A3").Select
End Sub
The problem with this code is it is giving the values like below:
Where expected result is:
Also, it should automatically paste the values to "I7:L7" if "I6:L6" is occupied and so on.
Can anyone show me how can I do that?
This is a long answer (and not the most efficient) but I wrote it this way to illustrate it step by step
See comments inside the code and adapt it to fit your needs
Public Sub GetDataByPersonName()
Dim sourceSheet As Worksheet
Dim sourceDataRange As Range
Dim rowOffset As Long
Dim sourceSheetName As String
Dim sourcePersonName As String
Dim sourceRangeAddress As String
Dim sourceLookupTableRange As String
Dim sourceMatchedRow As Variant
' Results
Dim resultsInitialCellAddress As String
Dim resultName As Variant
Dim resultID As Variant
Dim resultCountry As Variant
Dim resultDOB As Variant
Dim resultEmail As Variant
' Adjust to your needs
sourceSheetName = "Sheet1" ' Sheet name where data is located
sourceRangeAddress = "L2" ' Cell address of enter name
sourceLookupTableRange = "A4:E12" ' Range address where lookup data is located
resultsInitialCellAddress = "I4" ' Cell address of headers destination where results are going to be added
' Set references to sheet and lookup range
Set sourceSheet = ThisWorkbook.Worksheets(sourceSheetName)
Set sourceDataRange = sourceSheet.Range(sourceLookupTableRange)
' Get the current name to be looked up
sourcePersonName = sourceSheet.Range(sourceRangeAddress).Value
' Lookup the results (see columns(1) to check the column where name is located
sourceMatchedRow = Application.Match(sourcePersonName, sourceDataRange.Columns(1), 0)
If Not IsError(sourceMatchedRow) Then
' Find the last empty row below results header
If sourceSheet.Range(resultsInitialCellAddress).Offset(1, 0).Value = vbNullString Then
rowOffset = 1
Else
rowOffset = sourceSheet.Range(resultsInitialCellAddress).End(xlDown).Row - sourceSheet.Range(resultsInitialCellAddress).Row + 1
End If
' Name (see name column is 1 at the end for line)
resultName = Application.WorksheetFunction.Index(sourceDataRange, sourceMatchedRow, 1)
resultID = Application.WorksheetFunction.Index(sourceDataRange, sourceMatchedRow, 2)
resultCountry = Application.WorksheetFunction.Index(sourceDataRange, sourceMatchedRow, 3)
resultDOB = Application.WorksheetFunction.Index(sourceDataRange, sourceMatchedRow, 4)
resultEmail = Application.WorksheetFunction.Index(sourceDataRange, sourceMatchedRow, 5)
' Dump results into worksheet
sourceSheet.Range(resultsInitialCellAddress).Offset(rowOffset, 0).Value = resultName
sourceSheet.Range(resultsInitialCellAddress).Offset(rowOffset, 1).Value = resultID
sourceSheet.Range(resultsInitialCellAddress).Offset(rowOffset, 2).Value = resultCountry
sourceSheet.Range(resultsInitialCellAddress).Offset(rowOffset, 3).Value = resultDOB
sourceSheet.Range(resultsInitialCellAddress).Offset(rowOffset, 4).Value = resultEmail
End If
End Sub
Remeber to mark the answer if it helped you, to help others
Ok, I think you should try to do this yourself, and record your steps in a Macro. You will learn a ton that way. See the link below.
https://www.get-digital-help.com/how-to-return-multiple-values-using-vlookup-in-excel/
Turn on the Macro recorder before you click though the steps. Then, you will have all the code you need!!
The "for-each cell in range" statement seems to be running through the same cell multiple number of times.
See the screenshot.
It runs through the cell that has the word "Product" four time, because it is merged across four rows.
Is there a way to make it run only once, regardless of the design of the worksheet (in other words, I prefer not to use the fact that it is merged across four rows to be taken into account when coding).
Public Sub ProcessBeijingFile(Excel_UNC_Path As String)
Dim src As Workbook
Dim ProdPushWorkbook As Workbook
Set ProdPushWorkbook = ActiveWorkbook
Set src = Workbooks.Open(Excel_UNC_Path, True, True)
Dim c As Range
Dim r As Range
Dim LastRow As Long
Dim text As String
src.Sheets("Page 1").Activate
src.ActiveSheet.Range("A1").Select
LastRow = src.ActiveSheet.Range("A30000").End(xlUp).Row
text = LastRow
text = "A2:BA" + CStr(text)
Set r = Range(text)
Dim i As Integer
For i = 1 To MaxItems
PONumber(i) = ""
Next
Dim PageCounter As Integer
PageCounter = 0
RecordCounter = 0
Dim NextPONumber As String
NextPONumber = ""
For Each c In r
If Left(Trim(c.Value), 5) = "PO No" Then
NextPONumber = Trim(Replace(c.Value, "PO No.:", ""))
NextPONumber = Trim(Replace(NextPONumber, "PO No:", ""))
End If
....
If you don't care about performance and just want simple code, below demonstrates how you can go about skipping MergedCells. It displays address and value of non empty cells from Cell B1 in Immediate window until it reach empty cell. Kind of what you need.
Option Explicit
Sub Sample()
Dim oRng As Range
Set oRng = Range("B1")
Do Until IsEmpty(oRng)
Debug.Print oRng.Address, oRng.Value
Set oRng = oRng.Offset(1)
Loop
Set oRng = Nothing
End Sub
David pointed me in the right direction.
Here is the key:
if c.MergeCells then
If Trim(GetFirstWord(c.MergeArea.Address, ":")) = c.Address Then
'the first of merged cells, then process, else don't process...
Function Needed:
Public Function GetFirstWord(ByVal SearchString As String, Optional ByVal Delimeter As String = " ") As String
If SearchString = "" Then
GetFirstWord = ""
Else
Dim ary As Variant
ary = Split(SearchString, Delimeter)
GetFirstWord = ary(LBound(ary))
End If
' GetFirstWord = ary(LBound(ary))
'GetFirstWord = ary(LBound(ary))
End Function
I am trying to find a cell containing certain value in a different, closed file from where I am running my code. Once I find it, I want to receive the row number of said cell. Somehow my code won't work. It is a mixture of stuff I have found on this site and things I have coded myself. Any help would be great!
Dim file_dir As Workbook
Set file_dir = Workbooks.Open("PATH.xlsx")
Dim j As Integer
Dim n As Integer
Dim temp As Range
n = file_dir.ActiveSheet.Cells(file_dir.ActiveSheet.Cells.Rows.Count, "A").End(xlUp).Row
Set temp = file_dir.ActiveSheet.Range("A1:A" & n).Find(what:="LOOKUP_VALUE")
j = temp.Row
MsgBox j
Welcome to Stack Overflow, I can see you are a beginner so I thought I would show a different way of solving this. You need to learn the data types and what functions return so I think instead of using nested functions etc it is better to start off with a simpler code and then you can make it more sophisticated by making it run faster etc. It seems your value is in column A so instead of using FIND just loop and compare it to your lookup_value. Make sure that you give the lookup_value a real value inside the routine:
Sub Main()
Dim bValueFound As Boolean
Dim j As Integer
Dim n As Integer
Dim temp As Range
Dim WS As Worksheet
Dim file_dir As Workbook
Set file_dir = Workbooks.Open("PATH.xlsx")
Set WS = file_dir.ActiveSheet
n = WS.Cells(WS.Cells.Rows.Count, "A").End(xlUp).Row
Set temp = file_dir.ActiveSheet.Range("A1:A" & n)
For j = 1 To n
If WS.Cells(j, 1).Value = LOOKUP_VALUE Then
bValueFound = True
Exit For
End If
Next j
If bValueFound Then
MsgBox "The row is " & j
Else
MsgBox "Lookup value was not found"
End If
End Sub
I would like to hide multiple columns inside an excel worksheet. This works pretty fine using:
ActiveSheet.Range("R10:CO10").EntireColumn.Hidden = True
"R10" is the first and fix column to hide. The second column and all columns between to hide will be dynamically determined depending on it´s date value.
Sample Coding:
Private Sub Worksheet_Activate()
Dim c As Range
Dim start As String
Dim ende As String
start = "R10"
ende = "CO10"
Dim d As Date
d = Date
For Each c In Range("R10:HU10")
If c = (d - 8) Then
ende = **how to assign???**
End If
If c = (d - 7) Then
Application.Goto c, True
End If
Next c
'ActiveSheet.Range(**"start:ende"**).EntireColumn.Hidden = True
End Sub
Row 10 holds date values and I would like to hide all columns which dates are older than 7 days and I can´t find any hints about hiding multiple columns using variables or with column identifier or the number of the column etc.
The use of variables ends up in runtime error 1004.
As Scott pointed out, my first answer was not complete. You can use the following function:
Function GetColChars(col As Integer) As String
Dim coldown As Integer 'Column Countdown
Dim colrem As Integer 'Coumn Value Remaining
Dim colname As String 'Temporary String value for column name
Const alphanums = 26
Const aposition = 64
coldown = col
colname = ""
While coldown > 0
colrem = coldown Mod alphanums
If colrem = 0 Then colrem = 26
newchar = Chr(64 + colrem)
colname = newchar & colname
coldown = Int((coldown - 1) / alphanums)
Wend
GetColChars = colname
End Function
Then call the function to get the column letters:
ende = GetColChars(c.column)
I have tested Scotts solution approach and finally got it working. In that case that some other people will struggle with the same problems, getting a working solution, here is my solution:
Private Sub Worksheet_Activate()
Dim lastDateRangeColumn As Range
Dim givenDateRange As Range
Set givenDateRange = ActiveSheet.Range("R10:HU10")
Dim firstDateRangeColumn As Range
Set firstDateRangeColumn = ActiveSheet.Range("R10")
Dim todaysDate As Date: todaysDate = Date
For Each tempDateRangeColumn In givenDateRange
If tempDateRangeColumn < (todaysDate - 7) Then
Set lastDateRangeColumn = ActiveSheet.Range(tempDateRangeColumn.Address)
End If
If tempDateRangeColumn = (todaysDate - 7) Then
Application.Goto tempDateRangeColumn, True
End If
Next tempDateRangeColumn
Dim firstColumnNumber As Long
Dim lastColumnNumber As Long
firstColumnNumber = Range(firstDateRangeColumn.Address).Column
lastColumnNumber = Range(lastDateRangeColumn.Address).Column
Dim rangeToBeHidden As Range
Set rangeToBeHidden = Range(Cells(1, firstColumnNumber), Cells(1, lastColumnNumber))
rangeToBeHidden.EntireColumn.Hidden = True
End Sub