I have a macro which looks at a selection of data in specified cells, it takes the value from each row in the selection and populates an excel spreadsheet. The it calls another macro which runs.
This code works well when I start the start and finish cells, however I want to be able to use a variable range so it automatically finds the last cell and runs through the selection.
I've tried using 'For Each rngMyCell In Sheets("Selection").Range("A43").End(xlDown).Row however this only selects the last item in my list and doesn't run through all of them. Can anyone advise what I'm doing wrong.
Thanks,
Sub Macro1()
Sheets("Selection").Range("B6").Value = Now()
Dim rngMyCell As Range
Application.ScreenUpdating = False
For Each rngMyCell In Sheets("Selection").Range("A43:A50")
Sheets("Selection").Range("C3").Value = rngMyCell
Call RunAll
Next rngMyCell
Application.ScreenUpdating = True
Sheets("Selection").Range("B7").Value = Now()
MsgBox ("All done")
End Sub
In posted code: For Each rngMyCell In Sheets("Selection").Range("A43").End(xlDown).Row
you are looping through a number, but not range (which is wrong). The group in For Each...Next statement should be name of an object collection or array.
To loop dynamically through whole range, try this:
For Each rngMyCell In Sheets("Selection").Range("A43:A" & Sheets("Selection").Range("A43").End(xlDown).Row)
Related
I have code that uses a For loop to hide a number of columns based on a Cell value. The code is used in 7 sheets out of a Workbook that has 17 sheets in total (this information is relevant later).
Private Sub Worksheet_calculate()
Application.EnableEvents = False
On Error GoTo errorHandling
Dim controlCell As Range, tableToHide As Range
Set controlCell = Range("C12") 'Cell contains a formula to retrieve the value from a cell in a seperate sheet
Set tableToHide = Range("Table1") 'The name of the table where columns need to be shown/hidden based on controlCell value
tableToHide.EntireColumn.Hidden = False
For i = controlCell.Value To tableToHide.Columns.Count
tableToHide.Columns(i).EntireColumn.Hidden = True
Next i
errorHandling:
On Error GoTo 0
Application.EnableEvents = True
End Sub
I'm looking for a way to hide the columns without using a loop or a way to change this loop. The reason for wanting the change is because when this is used in its current form, changing any cell throughout the Workbook's 17 sheets results in a loading spinner showing for a few seconds. As you can imagine, that is not a great user experience.
You can hide all columns at once. Various ways to do so, eg
Dim startCol As Long
startCol = controlCell.value
Dim hideRange As Range
Set hideRange = tableToHide.Cells(1, startCol).Resize(1, tableToHide.Columns.Count - startCol + 1)
hideRange.EntireColumn.Hidden = True
I don't understand why you have this code inside the Worksheet_calculate() event: this causes the entire workbook to be checked every time a calculation is made.
Why don't you put that for-loop inside another macro, which you can run on demand, and use the Worksheet_calculate() event only to check the column you're actually calculating?
An excel spreadsheet that is as an input-form for users. Based on their input and selections via dropdown my intention is to guide them through the form by hiding & unhiding rows with input fields, presenting the users with the relevant questions.
On each row I have created an IF-formula that creates a 1 or 0 based on previous provided input 1 -> unhide the row , 0 -> hide the row.
So I'm looking for a macro that runs with every sheet calculation and hides or unhides the next rows as needed.
These formulas are in range I3:I70 on top of that I created a summary field in I2 =sum(I3:I70) so i thought I can either check changes in the range I3:I70 or changes on cell I2 to trigger the macro. [Neither solution fixed my problem]
I've tried several code examples discribed on the forums and I've tested the macros that checks for change in the range or the cell individually. As long as I call a test macro with a MsgBox it works fine. Also the macro that hides or unhides runs fine when I call it manually.
My problem: When I let the 'auto'-macro call the 'hide'-macro, Excel simply crashes; no warnings, nothing --> just crash.
My code:
Private Sub Worksheet_Calculate()
Dim Xrg As Range
Set Xrg = Range("H3:H70")
If Not Intersect(Xrg, Range("H3:H70")) Is Nothing Then
Macro1
End If
End Sub
Sub Sample()
MsgBox "Yes"
End Sub
Sub Macro1()
Dim cell As Range
For Each cell In Range("H3:H70")
If Not IsEmpty(cell) Then
If cell.Value = 0 Then
cell.EntireRow.Hidden = True
End If
If cell.Value = 1 Then
cell.EntireRow.Hidden = False
End If
End If
Next
End Sub
Thanks for any suggestions and tips in advance.
My main goal is to be able to autofilter merged cells in one column.In the picture below I want row 7-9 to disappear when I remove "6" from the autofilter menu. But as I have figured, I need the value "6" to be held in all the cells "L7:L9" in order for Excel to do so.
The number 6 is calculated by adding "Num1" and "Num2" (2 * 3) by the following function I have placed in "L7":
Function Exposure(arg1 As Range, arg2 As Range) As Variant
Application.EnableEvents = False
Application.Calculation = xlManual
If Application.ThisCell.Offset(, -1).Value <> "-" And Application.ThisCell.Offset(, -2).Value <> "-" Then
Exposure = Left(Application.ThisCell.Offset(, -1).Value, 1) * Left(Application.ThisCell.Offset(, -2).Value, 1)
End If
If Exposure = 0 Then Exposure = "-"
Application.Calculation = xlAutomatic
Application.EnableEvents = True
End Function
I put the following formula inside the merged cell "L7":=Exposure(K7;J7). Then formula is dragged down."Num1" and "Num2" are controlled by valdiation fields, drop-down menu.
My plan was to unmerge after calculating the Exposure Variant, fill the same value in the remaining rows, then re-merge the same area. So I wrote this stand alone Sub:
Sub WorkingSub(rng As Range)
'Set rng = ActiveCell.MergeArea
rng.UnMerge
For i = 2 To rng.Cells.Count
rng.Cells(i).Value = rng.Cells(1).Value 'This line triggers recursion
Next i
rng.Offset(rng.Cells.Count).Copy 'Copies format from below
rng.PasteSpecial Paste:=xlPasteFormats 'Paste that keeps the values even after merging
End Sub
Which works on its own, but not when called inside the function above. After setting the first value, the function triggers "something", debug show the the function starting over, skipping the rng.PasteSpecial Paste:=xlPasteFormats code.
So my question to you guys is how do i write my function(s) to stop "recursing" and let me unmerge during the function call?
Or am I attacking this the wrong way? What would you do?
I am stuck with merged cells for lots of reasons, this is just one part of many inside this spreadsheet.
An interesting problem. You can capture the filter event through trapping a change in a calculation and then processing the rows of the table for visibility. I've made some assumptions for the initial table range assignment which may need some alteration.
The If Not VisRange Is Nothing Then is actually redundant as the prior line will throw a fit if an empty range is assigned, but I just kept it in. In order to get around having a null range, keep the header range in the initial MergedTableRange so there will always be a row visible
Within a cell either somewhere in the same worksheet or a 'dummy' worksheet
=SUBTOTAL(103,Sheet1!A3:H10) 'Or other table range
In the worksheet module code
Private Sub Worksheet_Calculate()
Dim ws As Worksheet: Set ws = Worksheets("Sheet1")
Dim MergedTableRange As Range: Set MergedTableRange = ws.Range("A2").CurrentRegion
Dim Cell As Range
Dim VisRange As Range: Set VisRange = MergedTableRange.SpecialCells(xlCellTypeVisible)
If Not VisRange Is Nothing Then
For Each Cell In VisRange
If Not Application.Intersect(Cell.MergeArea, VisRange).Address = Cell.MergeArea.Address Then
Cell.Rows.Hidden = True
End If
Next Cell
End If
End Sub
I came up with a different approach. Maybe there's a downside I'm missing. But my few test runs have succeeded.
I allready have a hidden sheet named "Template" where the formats for each new "#" is stored. So whenever the user wants to insert a new row, the template have the merged and the non-merged cells ready and insert is done through copy paste.
In that same sheet I made 2 merged rows in column 2, 3 merged cells in column 3 and so on:
This way I'm able to copy the correct number of merged rows to paste after filling the unmerged rows with their correct values.
I came to the conclusion that I could catch a Worksheet_change on the "Num1" and "Num2" columns instead of catching and canceling an autofilter call.
So I added:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("J:J")) Is Nothing Then
Call UnMergeMerge(Cells(Target.Row, "L").MergeArea)
End If
If Not Intersect(Target, Target.Worksheet.Range("K:K")) Is Nothing Then
Call UnMergeMerge(Cells(Target.Row, "L").MergeArea)
End If
End Sub
And the UnMergeMerge sub ended up being:
Sub UnMergeMerge(rng As Range)
Application.EnableEvents = False
Application.ScreenUpdating = False
rng.UnMerge
For i = 2 To rng.Cells.Count
rng.Cells(i).Value = rng.Cells(1).Value
Next i
With Sheets("Template")
.Range(.Cells(8, rng.Cells.Count), .Cells(8 + rng.Cells.Count, rng.Cells.Count)).Copy
End With
rng.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Still not sure it's the fastest and best approach...Do you guys still believe catching, undoing and running a different autofilter would be more effective?
I am trying to use a 'Do Until' loop to take a value from list (Drop-down fields worksheet, starting at cell B19) and update a cell value another Excel Sheet (specifically, Data Collection worksheet, cell C1). Once I can get this to work, I will add already functioning code to save the file based on the value in C1 in the Data Collection worksheet.
I am testing the code but it is constantly getting stuck after the pulling that first value. Basically, it doesn't actually loop through the list until it ends.
I believe it has to do with what is classified as the active cell. I think when I paste the value that changes the active cell. I tried to correct this by re-iterating the active cell again. This might be creating an infinite loop though.
Is there something I can do to adjust this? Thank you in advance for looking at this and any replies you might have! I based structure on the documentation found at https://learn.microsoft.com/en-us/office/troubleshoot/excel/loop-through-data-using-macro
Code below:
Sub Test2()
' Select cell to start loop, *first line of data*.
Worksheets("Drop-down fields").Activate
Range("B19").Select
Worksheets("Drop-down fields").Range("B19").Copy
' Set Do loop to stop when an empty cell is reached.
Do Until IsEmpty(ActiveCell)
Worksheets("Data Collection").Range("C1").PasteSpecial Paste:=xlPasteValues
Worksheets("Drop-down fields").Activate
Range("B19").Select
' Step down 1 row from present location.
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Samuel,
Here's your code refactored to remove all the activates and selects and incrementing through you list in col B and copying to col C.
Sub Test2()
Dim wksSrc as Worksheet
Dim wksDst as Worksheet
Dim lSrcRow as Long
Dim lDstRow as Long
Set wksSrc = Worksheets("Drop-down fields")
Set wksDst = Worksheets("Data Collection")
lSrcRow = 19
lDstRow = 1
Do
wksSrc.cells(lSrcRow,2).Copy
wksDst.Cells(lDstRow,3).PasteSpecial Paste:=xlPasteValues
lSrcRow = lSrcRow + 1
lDstRow = lDstRow + 1
Loop Until wksSrc.cells(lSrcRow,lSrcCol) = ""
End Sub 'Test2
Note: code is untested but I think I got all the references right.
HTH
I have an IF statement working fine, but I need to use a VLookup as a range, as the cell that is the subject of the IF could be in a different row, but never a different column.
I'm brand new to VBA (but not to excel), so the VLookup was an instinctive move, but I'm not tied to it if I can achieve the same thing another way. I've been trying to find solutions online, but don't seem to actually answer this query.
The below is the original code with a static range.
Sub FINDTOTAL()
Dim Amount As String
Amount = "Subtotal"
thetotal = Application.WorksheetFunction.Vlookup(Amount, Sheet1.Range("G:H"), 2, False)
End Sub
Sub CalculateSubtotal()
If Range("H25") > 10000 Then
Sheets("Billing").Select
Else
Worksheets("Sheet1").Range("H25").Copy
MsgBox "Subtotal has been copied and can be pasted into the quote"
End If
End Sub
The VLookup works, and the IF statement works, I just can't get them to work together. I need the subtotal to be assessed for the IF statement regardless of where it is in the column (in probability, it could be anywhere between rows 3 - 50).
Maybe something like this:
Sub FindTotal()
Dim Total As Variant
Total = Application.VLookup("Subtotal", Sheet1.Range("G:H"), 2, False)
If Not IsError(Total) Then
If IsNumeric(Total) Then
If Total > 10000 Then
' Do one thing
Else
' Do another thing
End If
End If
End If
End Sub
If you want to write the total to another cell elsewhere, you don't need to copy, just a direct value transfer.
Demonstrating a Find/Offset approach:
Sub FindTotal()
Dim rng As Range
Set rng = Sheet1.Columns("G").Cells.Find(What:="Subtotal")
If Not rng Is Nothing Then
Dim totalRng As Range
Set totalRng = rng.Offset(, 1)
If IsNumeric(totalRng.Value) Then
If totalRng.Value > 10000 Then
' Do one thing
Else
' Do another thing
End If
End If
End If
End Sub