lookup a number and increment value in another cell within same row - vba

I would like to create a macro in excel that lets me increment the counts of a part whenever I press a command button.
Currently, my concept is to use vlookup to get the existing counts for that part using the following. However, it does not increment the actual counts value in the cell, which is what I want. I suspect it's cos vlookup is only used to return a value within the cell, but the cell is not activated in the process for actual increment. Can someone please advise how I can correct it? I'm still new to vba. Thanks!!! :)
E.g. Vlookup finds C1value in Cell A5 of Sheets("Location"). It will automatically increment the value in Cell C5 by 1.
Sub FindAddTools()
Dim C1Qnty As Double
C1value = Sheets("Issue").Range("D11")
Sheets("Location").Activate
C1Qnty = WorksheetFunction.VLookup(C1value, Range("A:D"), 3, False)
C1Qnty = C1Qnty + 1
End Sub
ADD ON: an add-on to my original question. I was wondering if it is possible to do the same for an entire range?
E.g. C1value is now a range of Sheets("Issue").Range("D11:D20"). I want to find all values within this range in Sheets("Location") and increment their corresponding counts in Column C.
Is there a way to do this without repeating the same procedure for all cells of the range?
Thanks! :)

Here's my shot at it. If the value isn't matched nothing happens:
Sub FindAddTools()
Dim RangeToMatch As Excel.Range
Dim cell As Excel.Range
Dim C1Value As Variant
Dim C1Row As Variant
Set RangeToMatch = Sheets("Issue").Range("D2:D11")
For Each cell In RangeToMatch
C1Value = cell.Value
With Sheets("Location")
C1Row = Application.Match(C1Value, .Range("A:A"), 0)
If Not IsError(C1Row) Then
.Range("C" & C1Row).Value = .Range("C" & C1Row).Value + 1
End If
End With
Next cell
End Sub
I edited it so that it cycles through a range of cells to match. That range is set to D2:D11 above.

Based on your comments, I think this should do it.
NB: you don't have to Activate worksheets to perform the functions referencing their cells/ranges.
Sub FindAddTools()
Dim shIssue as WOrksheet: Set shIssue = Sheets("Issue")
Dim shLoc as Worksheet: Set shLoc = Sheets("Location")
Dim allC1Values as Range
Dim C1Value as Variant
Dim C1Qnty As Double
Dim foundRow as Long
Set allC1Values = shIssue.Range("D11:D100") '## Modify as needed.
For each C1Value in allC1Values.Cells
C1Qnty = WorksheetFunction.VLookup(C1value, shLoc.Range("A:D"), 3, False)
C1Qnty = C1Qnty + 1
foundRow = WorksheetFunction.Match(c1Value,shLoc.Range("A:A"),False)
shLoc.Range("C" & foundRow).Value = CqQnty
Next
End Sub
Be careful with this. You're immediately writing to the same cell you just "found" with the VLOOKUP function, so, obviously if you run this macro again, you're going to increment it again. But, this may be the desired functionality, if so, no problem.
NOTE: There is no error trapping for if C1Value is not found in the VLOOKUP or MATCH functions.

Related

Multiply each value in a range by a constant, but skip blank cells

I need a simple a fast solution for multiplying all values in a range by a numeric value in VBA code. I know about this solution: Multiply Entire Range By Value?
Set rngData = ThisWorkbook.Worksheets("Sheet1").Range("A1:B10")
rngData = Evaluate(rngData.Address & "*2")
But it has a big drawback - if the original cell was blank, it results in zero. How to force it skip blank values?
I want to avoid looping through the values because it is very slow.
You can use your existing approach with Evaluate but get a little smarter with it - it can take conditions etc, so just include a test for ISBLANK. This example is tested on a combination of blank and non-blank cells in the range A1:C3 - just update for your range and give it a try:
Option Explicit
Sub Test()
Dim rng As Range
Set rng = Sheet1.Range("A1:C3")
'give the name a range so we can refer to it in evaluate
rng.Name = "foo"
'using Evaluate
rng = Evaluate("IF(ISBLANK(foo),"""",foo*2)")
'using [] notation
'preferred IMO as dont need to escape "
rng = [IF(ISBLANK(foo),"",foo*2)]
End Sub
I know you have an accepted answer, but for whatever it's worth it turns out you don't have to name the range. And in case the cells in the range contain text, then this one-line code works fine
Sub MultiplyRangeByConstant()
[A1:C3] = [IF(ISBLANK(A1:C3),"",IF(ISTEXT(A1:C3),A1:C3,2*A1:C3))]
End Sub
if there are formulas or anything else in the range:
'[a1:b3] = [{"=1","a";2,"=0/0";"",3}]
[a1:b3] = [if(a1:b3="","",if(isNumber(a1:b3),a1:b3*2,a1:b3))]
or to ignore the formulas, the good old PasteSpecial
Set temp = [c1].EntireRow.Find("") ' any blank cell that is not in the range
temp.Value = 2
temp.Copy
[a1:b3].SpecialCells(xlCellTypeConstants).PasteSpecial , Operation:=xlMultiply
temp.Value = ""

Defining cells in VBA

I'm trying to write a macro that allows a user to enter a new banknote serial number. The macro requires 3 inputs (currency, denomination and serial number). I'm a beginner to VBA, but the code I tried to write is below. Can anyone point out where I went wrong, or what needs to be changed to make it work? Thanks!
Sub TestSub()
Dim Note_Serial As Variant
Dim Note_Currency As Variant
Dim Note_Denomination As Variant
'Defining 3 inputs
Note_Currency = InputBox("Enter Currency (in 3 letter form):")
Note_Denomination = InputBox("Enter Note Denomination (with $ sign):")
Note_Serial = InputBox("Enter Serial Number:")
'Getting 3 inputs
Dim Currency_Cell As Range
Dim Denomination_Cell As Range
Dim Serial_Cell As Range
'Defining cells to write inputs
Currency_Cell = (D3)
Denomination_Cell = (E3)
Serial_Cell = (F3)
'Starting cells
Currency_Cell = Note_Currency
Denomination_Cell = Note_Denomination
Serial_Cell = Note_Serial
'Writing inputs to spreadsheet
Currency_Cell.Offset (1)
Denomination_Cell.Offset (1)
Serial_Cell.Offset (1)
'Moving all cells down 1 place
End Sub
Instead of writing Currency_Cell = (D3), you want to write Set Currency_Cell = Range("D3") (Assuming that you don't switch the active Worksheet).
EDIT: To prevent overwriting previously entered data, use instead:
Set Currency_Cell = Cells(Rows.Count, Range("D3").Column).End(xlUp).Offset(1, 0)
This will select the first empty Cell in Column D.
To move the cell reference, you have to also use the Set keyword, and give the offset in rows and columns:
Set Currency_Cell = Currency_Cell.Offset (1, 0)

Range object returns empty values

I have a set range to a variable in this fashion:
Dim srcRng As Range
Set srcRng = Range(hrwb.Worksheets(1).Range(yomColAddress)(1).Address, _
Cells(hrwb.Worksheets(1).Range(yomColAddress).row + 200, rightMostCol)(1).Address)
for some weird reason when I call
srcRng(1) 'actually instead of 1 is i that runs 1 to srcRng.Count
it doesn't return the upper leftmost cell value. Any ideas why?
(for those who are not familiar with this technique: http://www.cpearson.com/excel/cells.htm)
Informations:
at execution time the variables yomColAddress=$AL$9 and righMostCol=40
hrwb.Worksheets(1).Range(yomColAddress)(1) works as expected.
With MsgBox srcRng(1).Address & " value:" & srcRng(1).Value I get "$AL$9 value:"
The value of AL9 is the text "yom"
The actual code is:
Dim srcRng As Range
Set srcRng = Range(hrwb.Worksheets(1).Range(yomColAddress)(1).Address, Cells(hrwb.Worksheets(1).Range(yomColAddress).row + 200, rightMostCol)(1).Address)
Dim i As Integer
i = 1
While (weekDayCol = 0 And i <= srcRng.count)
If loneHebDayLetter("à", "ä", srcRng(i)) Then'loneHebDayLetter checks some conditions on a cell
weekDayCol = srcRng(i).Column
End If
i = i + 1
Wend
I think I get what goes wrong here:
The code itself is working well but not on the good data (This is a supposition but I just did some tests with a custom workbook)
Short version
Just add srcRng.Select after Set srcRng (no real interest but to understand what it does) and I think you will get what happens if my supposition is correct.
Longer version
When you do Set srcRng = ... it does create the correct Range but it is not linked to any sheet actually ... It just means remember a Range which goes from cell X to cell Y.
The point is: The sheet (let's say "sheet2") where your code is executed isn't the same as the one where the datas are (say "sheet1") so srcRng(1) is understood as Sheets("sheet2").srcRng(1) instead of Sheets("sheet1").srcRng(1) (<- that's what you want)
Even if not elegant, this should work:
Dim srcRng As Range
With hrwb.Worksheets(1)
Set srcRng = Range(.Range(yomColAddress)(1).Address, Cells(.Range(yomColAddress).row + 200, rightMostCol)(1).Address)
Dim i As Integer
i = 1
While (weekDayCol = 0 And i <= srcRng.count)
If loneHebDayLetter("à", "ä", .Range(srcRng.Address)(i).Value) Then 'I assume it take the value not the cell: if it take the cell you may get an error!
weekDayCol = srcRng(i).Column
End If
i = i + 1
Wend
End With
What is important is the use of .Range(srcRng.Address)(i).Value to access the value in the right worksheet! (That's why this trick is not needed here: srcRng(i).Column because colum numbers do not change from one sheet to an other)
(NOTE: I used with to optimize/clarify the code)
If something isn't clear tell me

Hlookup and Match equivalent in VBA

sample.xls image
I have a code below, but it's not working properly. Something is missing in this code. Could you please help me with it?
Thanks in advance.
I added a sample.xls to show my request.
sample.xls
i dont have an error handler, my function with hlookup and match returns a value. but it returns with the same result (value) for each cell in range(N6:CQ7899). normally if i use formula in cell N6 =IFERROR(HLOOKUP(N$5,min!$C$2:$CF$7899,MATCH($E6,min!$B$2:$B$7899,0),FALSE);0) and go to last row and last col, each cell will have unique criteria with both hlookup and match. my request is how to do it by macro as follows;
do for rows in ranges N6:N7899, O6:O7899, ... and CQ6:CQ7899
N6
=IFERROR(HLOOKUP(N$5,min!$C$2:$CF$7899,MATCH($E6,min!$B$2:$B$7899,0),FALSE);0),
N7
=IFERROR(HLOOKUP(N$5,min!$C$2:$CF$7899,MATCH($E7,min!$B$2:$B$7899,0),FALSE);0)`,.,.,.,.
up to last row.
and do for columns;
O6
=IFERROR(HLOOKUP(**O$5**,min!$C$2:$CF$7899,MATCH(***$E6***,min!$B$2:$B$7899,0),FALSE);0),
O7
=IFERROR(HLOOKUP(**O$5**,min!$C$2:$CF$7899,MATCH(***$E7***,min!$B$2:$B$7899,0),FALSE);0).,.,.,.
up to last cell (CQ7899) in column CQ.
if possible, please check sample.xls image or xls file.
Function matcd()
Dim adegm As Range
Dim adizm As Range
Dim adegh As Range
Dim adizh As Range
Dim rnghFormulaCell As Range
Dim varResult1 As Variant
Set adegh = Worksheets("ara").Range("N5")
Set adizh = Worksheets("min").Range("C2:CF7899")
Set adegm = Worksheets("ara").Range("E5:E")
Set adizm = Worksheets("min").Range("B2:B7899")
Set rnghFormulaCell = Worksheets("ara").Range("N6:CQ7899") '
Worksheets("ara").Range("N6:CQ" & Rows.Count).ClearContents
varResult1 = Application.WorksheetFunction.HLookup(adegh, adizh, Application.WorksheetFunction.Match(adegm, adizm, 0), 0)
'.....
'i don't know how to Add results of varResult1 to an array in rnghFormulaCell
'.....
If Not IsError(varResult1) Then rnghFormulaCell = varResult1
End Function

VBA code to hide a number of fixed discrete rows across a few worksheets

I'm for a solution to part of a macro I'm writing that will hide certain (fixed position) rows across a few different sheets. I currently have:
Sheets(Sheet1).Range("5:20").EntireRow.Hidden = True
To hide rows 5-20 in Sheet1. I also would like to hide (for arguements sake), row 6, row 21, and rows 35-38 in Sheet2 - I could do this by repeating the above line of code 3 more times; but am sure there's a better way of doing this, just as a learning exercise.
Any help much appreciated :)
Chris
Specify a Union of some ranges as follows
With Sheet1
Union(.Range("1:5"), .Rows(7), .Range("A10"), .Cells(12, 1)).EntireRow.Hidden = True
End With
Here is a try:
Sub hideMultiple()
Dim r As Range
Set r = Union(Range("A1"), Range("A3"))
r.EntireRow.Hidden = True
End Sub
But you cannot Union range from several worksheets, so you would have to loop over each worksheet argument.
This is a crude solution: no validation, no unhiding of existing hidden rows, no check that I have a sheet name as first parameter, etc. But it demonstrates a technique that I often find useful.
I load an array with a string of parameters relevant to my current problem and code a simple loop to implement them. Look up the sub and function declarations and read the section on ParamArrays for a variation on this approach.
Option Explicit
Sub HideColumns()
Dim InxPL As Integer
Dim ParamCrnt As String
Dim ParamList() As Variant
Dim SheetNameCrnt As String
ParamList = Array("Sheet1", 1, "5:6", "Sheet2", 9, "27:35")
SheetNameCrnt = ""
For InxPL = LBound(ParamList) To UBound(ParamList)
ParamCrnt = ParamList(InxPL)
If InStr(ParamCrnt, ":") <> 0 Then
' Row range
Sheets(SheetNameCrnt).Range(ParamCrnt).EntireRow.Hidden = True
ElseIf IsNumeric(ParamCrnt) Then
' Single Row
Sheets(SheetNameCrnt).Range(ParamCrnt & ":" & _
ParamCrnt).EntireRow.Hidden = True
Else
' Assume Sheet name
SheetNameCrnt = ParamCrnt
End If
Next
End Sub