how to runs macro based on value in cell? - vba

I have the macro called "macro3" to runs in sheet1
and I have cells B7 in sheet2 that contain the value, lets say "12"
how to runs the macro 12x (based on value in cells B7 in sheet2) with one button?

Welcome to StackOverflow! Make sure that the next time you ask a question you read the rules - https://stackoverflow.com/help/how-to-ask
Concerning this question - take a look at the code below, it is a for-loop:
Public Sub TestMe()
Dim timesToRun As Long
Dim cnt As Long
timesToRun = Worksheets(2).Range("B7")
For cnt = 1 To timesToRun
macro3
Next cnt
End Sub

I suggest doing the following:
Sub RunMacro()
Worksheets("sheet2").Select
Dim MacroCounter As Integer
MacroCounter = Range("B7").Value
For x = 1 To MacroCounter
Call macro3
Next x
End Sub

Related

Find the first empty cell after a text in a row

I'm working on a project and need at the moment to find the first empty cell just after text cells in a row in Excel. To clarify, let me explain to you what I'm lookng for with this screenshot
I want to write a code to return for me for like an example in the case of the 20th row the number of column of the cell E20 even if the first empty cell is A20 but like I said, i want the first empty cell juste after the last "not empty" one.
for the 21th row the result will be C21, the 22th row it will be F22 and there you go
Here's the code I wrote but for some reason it doesn't work, please help.
Function emptyCell(ws As Worksheet, ligne As Integer)
Dim m, p, n As Integer
Dim suite(700) As Integer
For k = 0 To 700
suite(k) = 0
Next
emptyCell = 0
i = 1
Do Until suite(i) = 0 And suite(i - 1) = 1
If ws.Cells(ligne, i) <> "" Then
suite(i) = 1
End If
i = i + 1
emptyCell = emptyCell + 1
Loop
End Function
Sub test()
Dim d As Integer
empty_cell = emptyCell(Sheets("tmp"), 2)
MsgBox (empty_cell)
End Sub
The logic of my code is to assign 0 for empty cells and 1 in the other caase, run a test to find the first 1-0 that's gonna appear in my array and get the column order from the order of this "1"
I know I'm not that clear cause I didnt want it to make it a long post and english is not my first language.
Thanks in advance
All if you want to get the first empty cell after the last non empty cell, why not try it like this?
Function emptyCell(ws As Worksheet, Row As Long) As Range
Set emptyCell = ws.Cells(Row, ws.Columns.Count).End(xlToLeft).Offset(, 1)
End Function
Sub Test()
Dim empty_cell As Range
Set empty_cell = emptyCell(Sheets("tmp"), 20)
MsgBox empty_cell.Address
End Sub

How to keep macro looping on a specified worksheet even when I switch worksheets in the same workbook

I tried to look for answers to this question but to no avail. I need this Macro to run on a specific worksheet called General on a specific workbook. The purpose, is to let the cell I24 be multiplied by 1.0003 every minute (which makes it a loop as far as I know). The below code only works when I have the General sheet opened. It stops looping when I switch to another worksheet.
Also, I want the macro to run automatically open opening the workbook, regardless of the General sheet being selected, so that I24 on the General sheet keeps getting multiplied without being redirected to the sheet. Just so you know, I have that cell referenced on various other sheets in the workbook, that is why I need the macro constantly running. Below is my code (It may not be at its optimum condition since I am very new to VBA):
Sub auto_open()
WshtNames = Array("General")
Application.ScreenUpdating = False
Dim num As Long
num = Sheets("General").Range("I24").Value
num = num * 1.0003
Range("I24").Value = num
Application.OnTime Now + TimeValue("00:01:00"), "auto_open"
Application.ScreenUpdating = True
End Sub
Thank you, I really appreciate your assistance.
Analyzing your code and making some suggestions to improve and remove unnecessary code
Switching Application.ScreenUpdating doesn't make much sense in this specific case, because there is only one update in Range("I24"). Therefore no gain if you turn it off.
There is only an advantage if you have many updates, so that they get performed all at once when switching Application.ScreenUpdating = True.
Use Option Explicit. This forces you to declare all your variables properly.
You set WshtNames but never use it, so this line can be removed.
Use Worksheets instead of Sheets unless you really need to use Sheets (Sheets also contains charts not only worksheets).
If num is Long then it can only contain integer/whole numbers. Therfore if you multiply num = num * 1.0003 it will automatically cast into Long which is the same result as num = num and that means it doesn't change anything. You will need to use at least Double or Decimal here.
You didn't specify a worksheet for the Range("I24").Value = num so Excel assumes that the range is in the active sheet. This is why your code fails when you select another sheet. Never let VBA guess the worksheet always specify the correct one Worksheets("General").Range("I24").Value = num.
So all together we can change your code from …
Sub auto_open()
WshtNames = Array("General") '(3) can be removed because WshtNames is never used
Application.ScreenUpdating = False '(1) dosn't make much sense
Dim num As Long '(5) wrong data type
num = Sheets("General").Range("I24").Value '(4) use worksheets
num = num * 1.0003 'see (5)
Range("I24").Value = num '(6) Always specify a worksheet
Application.OnTime Now + TimeValue("00:01:00"), "auto_open"
Application.ScreenUpdating = True
End Sub
Into this …
Option Explicit
Public Sub auto_open()
Dim num As Double
With Workheets("General") 'note we use a with statement to specify the sheet for the ranges (starting with a dot now!)
num = .Range("I24").Value
num = num * 1.0003
.Range("I24").Value = num
End With
Application.OnTime Now + TimeValue("00:01:00"), "auto_open"
End Sub
Or even shorter, because we don't need the num variable for that short calculation:
Option Explicit
Public Sub auto_open()
With Workheets("General") 'note we use a with statement to specify the sheet for the ranges (starting with a dot now!)
.Range("I24").Value = .Range("I24").Value * 1.0003
End With
Application.OnTime Now + TimeValue("00:01:00"), "auto_open"
End Sub
This part of the code has wrong logic:
Dim num As Long
num = Sheets("General").Range("I24").Value
num = num * 1.0003
Long is a whole number by specification. If you multiply it by 1.0003 it is the same as if it is multiplied by 1. Consider using Double instead.
Or Decimal, for better precision:
Dim num as Double
num = Sheets("General").Range("I24")
num = CDec(num * 1.0003)
You must set your cell as a variable.
Dim myCell as Range
Set myCell = ThisWorkbook.Worksheets("General").Range("I24")
and in the code:
myCell.Value = num
EDIT:
The whole code:
Sub auto_open()
WshtNames = Array("General")
Application.ScreenUpdating = False
Dim myCell As Range
Set myCell = ThisWorkbook.Worksheets("General").Range("I24")
myCell = myCell * 1.0003
Application.OnTime Now + TimeValue("00:01:00"), "auto_open"
Application.ScreenUpdating = True
End Sub

CountIf does not work as expected when used multiple times in a function

Hello I am trying to run the following code to count the number of times something appears in a sheet.
Sub test()
' passes in what sheet (Sheet1) to search and which row (5) to write the results
dummy = CountExample("Sheet1", 5)
End Sub
Function CountExample(Sheet As String, RowPopulate As Integer)
Sheets(Sheet).Select ' Selects the appropriate sheet to search through
Dim tmp As Integer
' Search for find1
tmp = Application.WorksheetFunction.CountIf(Cells, "find1")
Sheets("Recording Sheet").Select
Range("C" & RowPopulate).Value = tmp ' Update and write the value in C5
tmp = 0 'this does not seem to do anything
' something wrong with this one find2 should have 39 matches not 15
' Search for find2
tmp = Application.WorksheetFunction.CountIf(Cells, "find2")
Sheets("Recording Sheet").Select
Range("E" & RowPopulate).Value = tmp ' Update and write the value in E5
End Function
When I just run the code to just search for find2 (after removing the code for searching for find1) I get 39 matches which is correct but if I run the code as above I get 15 matches for find2.
I can't seem to figure out why this is happening.
Thanks
The scope of your worksheet/range objects is not correct. A common mistake, and one reason to avoid relying on constructs like Select and Activate methods, unless otherwise explicitly stated, a range object always refers to the ActiveSheet.
Try this instead (edited per Garys suggestion to use a subroutine instead of a function):
Sub test()
' passes in what sheet (Sheet1) to search and which row (5) to write the results
CountExample "Sheet1", 5
End Sub
Sub CountExample(Sheet As String, RowPopulate As Integer)
' Selects the appropriate sheet to search through
Dim tmp As Integer
Dim ws as Worksheet
Dim wsRecord as Worksheet
Set ws = Worksheets(Sheet)
Set wsRecord = Worksheets("Recording Sheet")
' Search for find1
tmp = Application.WorksheetFunction.CountIf(ws.Cells, "find1")
wsRecord.Range("C" & RowPopulate).Value = tmp ' Update and write the value in C5
tmp = 0 'this does not seem to do anything
' something wrong with this one find2 should have 39 matches not 15
' Search for find2
tmp = Application.WorksheetFunction.CountIf(ws.Cells, "find2")
wsRecord.Range("E" & RowPopulate).Value = tmp ' Update and write the value in E5
End Sub
You need a Sub rather than a Function since you want to change a set of cells rather than return a single value
You are using Sheets("Recording Sheet").Select to switch to "Recording Sheet", but you are not switching back to Sheet. So the second CountIf is occurring on "Recording Sheet".

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

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.

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