I have a VBA calculation that is looping to recalculate cells 500 (or whatever the iteration is) times. For each recalculation there is an output which I want a record of after the loop is complete. I have tried a few different ways but I can't seem to get it right. Here is an example of what I have so far.
Private Sub CommandButton1_Click()
Dim Iteration As Integer, i As Integer
Iteration = Range("C4")
For i = 1 To Iteration
Range("C14,C15,C16,C17,C18,C19,C20").Calculate
Range("C20").Copy
Range("J" & Rows.Count).End(xlUp).Offset(1).Select.PasteSpecial xlPasteValues
Next i
End Sub
I think the only problem is that you are selecting in the same line as pasting special. Try this:
Private Sub CommandButton1_Click()
Dim Iteration As Integer, i As Integer
Iteration = Range("C4")
For i = 1 To Iteration
Range("C14,C15,C16,C17,C18,C19,C20").Calculate
Range("C20").Copy
Range("J" & Rows.Count).End(xlUp).Offset(1,0).PasteSpecial Paste:=xlPasteValues
Next i
End Sub
Try this:
Private Sub CommandButton1_Click()
Dim Iteration As Integer, i As Integer
Dim val as Variant
Iteration = Range("C4")
For i = 1 To Iteration
Range("C14,C15,C16,C17,C18,C19,C20").Calculate
val = Range("C20").Value
Debug.print "i: " & i & " val: " & val
Range("J" & Rows.Count).End(xlUp).Offset(1) = val
Next i
End Sub
If the correct values do not show up in the immediate window, the problem lies elsewhere. Obviously, delete the debug.print statement, if the code works as expected.
Private Sub CommandButton1_Click()
Dim Iteration As Integer, i As Integer
Iteration = Range("C4")
Dim RLog As Range ' prepare a range for the log
Set RLog = [C22] ' or wherever you want to start the log range
For i = 1 To Iteration
Range("C14,C15,C16,C17,C18,C19,C20").Calculate
RLog(i,1) = [C20] ' write the current result to the range (short notation [C20] is aequivalent to Range("R20")
Next i
End Sub
Related
I am in the process of writing a macro that allows me to update data monthly. However, I realized that sometimes I will need to overwrite the data from the same month when there is a correction issued to the data. I am trying to come up with a macro that will allow me to search the entire column and if there is a match with the data, allow me to run another macro to overwrite the old data with the new data. Any ideas of how to go about this?
Here is what I have so far. I need to replace to i to 500 with the entire column.
Sub FindMatchingValue()
Dim i As Integer, ValueToFind As Integer
intValueToFind = Sheet8.Range("L6")
For i = 1 To 500 ' This needs to be the entire column
If Cells(i, 1).Value = intValueToFind Then
MsgBox ("Found value on row " & i)
Exit Sub
End If
Next i
MsgBox ("Value not found in the range!")
End Sub
You do not want to run a loop down your entire column (slightly over 1 mil X). Instead, find your last row form the bottom, and loop through that range.
If your goal is to run a second Macro when you do find a match, you can get rid of your msgbox and Exit Sub and replace with Call SecondMacro, where "SecondMacro" is the name you assigned to your sub of course. Just an option ~
Sub FindMatchingValue()
Dim i As Integer, ValueToFind As Integer, LRow as Integer
intValueToFind = Sheet8.Range("L6")
LRow = Range("A" & Rows.Count).End(XlUp).Row
For i = 1 To LRow
If Cells(i, 1).Value = intValueToFind Then
MsgBox ("Found value on row " & i)
Exit Sub
End If
Next i
MsgBox ("Value not found in the range!")
End Sub
I am trying to do a For-Next loop,
at the beginning, I will select row 1&2, then row 1&3, then row 1&4 ...etc
I tried the following but excel would treat my "i" as column i instead of the row number. How this problem can be fixed?
Sub test123()
Dim i As Long
For i = 2 To 51
Range("1:1,i:i").Select
Selection.Copy
'other code
Next i
End Sub
You can't insert your variable names within a String - you need to include the value of the variable within the String instead.
Sub test123()
Dim i As Long
For i = 2 To 51
Range("1:1," & i & ":" & i).Select
Selection.Copy
'other code
Next i
End Sub
Note: There should be no need to actually Select the ranges:
Sub test123()
Dim i As Long
For i = 2 To 51
Range("1:1," & i & ":" & i).Copy
'other code
Next i
End Sub
Another alternative way to go is using the Union, between each pair of Rows you want to copy:
Option Explicit
Sub test123()
Dim i As Long
For i = 2 To 51
Union(Rows(1), Rows(i)).Copy
'other code
Next i
End Sub
Note: there's ne need to Select the range before copying it, you can directly use the copy on the fully qualified Range.
I need to get ranges from pre-set columns and a row from a variable. If i try to get this range by hand everything works. How do i get the same range using the variable?
How do i get from:
Dim j As Integer
j = 20
MsgBox Union(Sheets("Temp").Range("H10:H20"), _
Sheets("Temp").Range("K10:K20")).Address
... to something like this: (only that it works?)
MsgBox Union(Sheets("Temp").Range("H10:H" & j ), _
Sheets("Temp").Range("K10:K" & j)).Address
Here you go:
Option Explicit
Public Sub TestMe()
Dim j As Long
j = 20
MsgBox Union(Sheets(1).Range("H10:H" & j), _
Sheets(1).Range("K10:K" & j)).Address
End Sub
Result:
I think what you're asking is how you change j (20) into a dynamic variable? if so, something like this will do it:
Option Explicit
Public Sub TestMe()
Dim j As Long
j = Range("H10").End(xlDown).Row
MsgBox Union(Sheets(1).Range("H10:H" & j), _
Sheets(1).Range("K10:K" & j)).Address
End Sub
Please note: it there's an empty cell in the H column then j will be the row immediately above it - a work-around this would be j = Range("H" & Columns("H:H").Rows.Count).End(xlUp).Row
Can anyone walk me through how to write a script to delete the entire row if a cell in column D = "" on sheet 3 in range D13:D40.
Also, how to prevent the user from accidentally running the script again once those cells in the range are already deleted and other cells are now on the D13:D40 range?
Solution: This is working for me:
Sub DeleteRowsWithEmptyColumnDCell()
Dim rng As Range
Dim i As Long
Set rng = ThisWorkbook.ActiveSheet.Range("D13:D40")
With rng
' Loop through all cells of the range
' Loop backwards, hence the "Step -1"
For i = .Rows.Count To 1 Step -1
If .Item(i) = "" Then
' Since cell is empty, delete the whole row
.Item(i).EntireRow.Delete
End If
Next i
End With
End Sub
Explanation: Run a for loop through all cells in your Range in column D and delete the entire row if the cell value is empty. Important: When looping through rows and deleting some of them based on their content, you need to loop backwards, not forward. If you go forward and you delete a row, all subsequent rows get a different row number (-1). And if you have two empty cells next to each other, only the row of the first one will be deleted because the second one is moved one row up but the loop will continue at the next line.
No need for loops:
Sub SO()
Static alreadyRan As Integer
restart:
If Not CBool(alreadyRan) Then
With Sheets("Sheet3")
With .Range("D13:D40")
.AutoFilter 1, "="
With .SpecialCells(xlCellTypeVisible)
If .Areas.Count > 1 Then
.EntireRow.Delete
alreadyRan = alreadyRan + 1
End If
End With
End With
.AutoFilterMode = False
End With
Else
If MsgBox("procedure has already been run, do you wish to continue anyway?", vbYesNo) = vbYes Then
alreadyRan = 0
GoTo restart:
End If
End If
End Sub
Use AutoFilter to find blank cells, and then use SpecialCells to remove the results. Uses a Static variable to keep track of when the procedure has been run.
Here's my take on it. See the comments in the code for what happens along the way.
Sub deleterow()
' First declare the variables you are going to use in the sub
Dim i As Long, safety_net As Long
' Loop through the row-numbers you want to change.
For i = 13 To 40 Step 1
' While the value in the cell we are currently examining = "", we delete the row we are on
' To avoid an infinite loop, we add a "safety-net", to ensure that we never loop more than 100 times
While Worksheets("Sheet3").Range("D" & CStr(i)).Value = "" And safety_net < 100
' Delete the row of the current cell we are examining
Worksheets("Sheet3").Range("D" & CStr(i)).EntireRow.Delete
' Increase the loop-counter
safety_net = safety_net + 1
Wend
' Reset the loop-counter
safety_net = 0
' Move back to the top of the loop, incrementing i by the value specified in step. Default value is 1.
Next i
End Sub
To prevent a user from running the code by accident, I'd probably just add Option Private Module at the top of the module, and password-protect the VBA-project, but then again it's not that easy to run it by accident in the first place.
This code executes via a button on the sheet that, once run, removes the button from the worksheet so it cannot be run again.
Sub DeleteBlanks()
Dim rw As Integer, buttonID As String
buttonID = Application.Caller
For rw = 40 To 13 Step -1
If Range("D" & rw) = "" Then
Range("D" & rw).EntireRow.Delete
End If
Next rw
ActiveSheet.Buttons(buttonID).Delete
End Sub
You'll need to add a button to your spreadsheet and assign the macro to it.
There is no need for loops or filters to find the blank cells in the specified Range. The Range.SpecialCells property can be used to find any blank cells in the Range coupled with the Range.EntireRow property to delete these. To preserve the run state, the code adds a Comment to the first cell in the range. This will preserve the run state even if the Workbook is closed (assuming that it has been saved).
Sub DeleteEmpty()
Dim ws As Excel.Worksheet
Set ws = ActiveSheet ' change this as is appropriate
Dim sourceRange As Excel.Range
Set sourceRange = ws.Range("d13:d40")
Dim cmnt As Excel.Comment
Set cmnt = sourceRange.Cells(1, 1).Comment
If Not cmnt Is Nothing Then
If cmnt.Text = "Deleted" Then
If MsgBox("Do you wish to continue with delete?", vbYesNo, "Already deleted!") = vbNo Then
Exit Sub
End If
End If
End If
Dim deletedThese As Excel.Range
On Error Resume Next
' the next line will throw an error if no blanks cells found
' hence the 'Resume Next'
Set deletedThese = sourceRange.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not deletedThese Is Nothing Then
deletedThese.EntireRow.Delete
End If
' for preserving run state
If cmnt Is Nothing Then Set cmnt = sourceRange.Cells(1, 1).AddComment
cmnt.Text "Deleted"
cmnt.Visible = False
End Sub
I've recently had to write something similar to this. I'm not sure that the code below is terribly professional, as it involves storing a value in cell J1 (obviously this can be changed), but it will do the job you require. I hope this helps:
Sub ColD()
Dim irow As long
Dim strCol As String
Sheets("sheet2").Activate
If Cells(1, 10) = "" Then
lrun = " Yesterday."
Else: lrun = Cells(1, 10)
End If
MsgBox "This script was last run: " & lrun & " Are you sure you wish to continue?", vbYesNo
If vbYes Then
For irow = 40 To 13 step -1
strCol = Cells(irow, 4).Value
If strCol = "" Then
Cells(irow, 4).EntireRow.Delete
End If
Next
lrun = Now()
Cells(1, 10) = lrun
Else: Exit Sub
End If
End Sub
I have a simple index file which will cycle through 500+ files and will retrieve relevant information. One of the index fields is a VLookUp, which references another sheet in the active index Workbook. While testing the script, the VLookUp function cannot find the appropriate value, even though it will when I manually enter the same formula into a cell. Any ideas why this might be happening (it returns "N/A" every time, as indicated by the ErrorHandling):
Public Sub UpdateIndex()
Dim RowNumber As Integer, LookUpLast As Integer
Dim Control As String, PartNumber As String, PartDescription As String, Rev As String
Dim LookUp As Range, IndexLookup As Variant
Control = "Arbitrary"
RowNumber = 2
With ThisWorkbook.Worksheets(Sheet2)
LookUpLast = .Range("A" & Rows.Count).End(xlUp).Row
Set LookUp = .Range(.Cells(2, 1), .Cells(LookUpLast, 2)) 'Had previously tried Range("A2", "B" & LookUpLast)
End With
IndexLookup = Application.WorksheetFunction.VLookUp(Control, LookUp, 2, False)
With ThisWorkbook.Worksheets(Sheet1)
.Range("D" & RowNumber) = IndexLookup
End With
RowNumber = RowNumber + 1
Next File
Exit Sub
ErrorHandler:
If Err.Number = 1004 Then
IndexLookup = "N/A"
Resume Next
End If
End Sub