I'm trying to delete every cell, and a cell to the left of it, if the value of the cell is 0. (Also, to set the interior color to no fill if the value of the cell is greater than 0.)
This is my code so far
For Each cell In Range("I2:I" & LastTransaction)
If cell.Value = 0 Then
Range(cell.Offset(0, -1).Address, cell.Address).Delete Shift:=xlUp
ElseIf cell.Value > 0 Then
cell.Interior.ColorIndex = 0
End If
Next cell
The problem here is that, every time the cells are deleted, AND SHIFTED UPWARDS, the for each loop doesn't take the upward shift into account, and skips the next cell in the range.
As per #JvdV's comment, when deleting in a loop you need to do it back to front (or in this case bottom to top), using Step -1.
In this case your For loop would look something like;
For x = LastTransaction to 2 Step -1
If Range("I" & x).Value = 0 then
Range("H" & x & ":I" & x).Delete Shift:=xlUp
ElseIf Range("I" & x).Value > 0 Then
Range("I" & x).Interior.ColorIndex = 0
End If
Next
The main issue is that, when you loop through the range, each cell refers to a particular cells on the sheet.
So your loop loops through I2, I3, I4, .... If you delete a row, all the other rows are moved up, and what was in cell Ix is now in cell I(x-1), but the loop will be at cell Ix, and so a whole row will have avoided being processed.
One solution is to store all the rows that are to be deleted in a Collection, and then delete the collection afterwards.
'data
Cells.Clear
For i = 1 To 15
Cells(i, 1) = Int(Rnd * 4)
Cells(1, i + 2) = Cells(i, 1)
Next i
'code
Dim tbd As New Collection 'to be deleted collection
For Each c In [a1:a15]
If c = 1 Then tbd.Add c 'adds a row that is to be deleted
Next c
For Each c In tbd
c.Delete 'deletes all rows in tbd
Next c
The first part of the code creates some sample data to process. Then it defines a new Collection, adds the rows to it that are to be deleted (anything with a value 1 is this case), and then deletes them from the collection.
I've got a workbook containing a Summary sheet and 200 numbered sheets that the user fills in one after the other.
The following macro checks about 125 cell values on every numbered sheet, and fills in the Summary, one line per numbered sheet.
If a numbered sheet hasnt been used yet, the macro fills in every column from column D to column DV with the minus sign "-" and goes on to check every numbered sheet one after the other till there's no more to check.
Is there a way to set it so that if an arbitrary number (let's say 10 lines) of the newly generated lines contain only the minus sign "-" from D to DV (Iw,4 to Iw, 126), then the macro would reach its end as it means all the remaining numbered sheets aren't used yet?
Sub SummaryMacro()
Dim Sh As Worksheet
Range("B2:L1000").ClearContents
Iw = 2 ' Index Write
For Each Sh In ActiveWorkbook.Sheets
If Sh.Name = "Summary" Then GoTo EndConsolidation
Cells(Iw, 1).Select
With Selection
.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & Sh.Name & "'" & "!" & "A1", TextToDisplay:="Go to"
End With
Cells(Iw, 2) = Sh.Name
If Sh.Range("D8") = "" Then
Cells(Iw, 3) = "-"
Else
Cells(Iw, 3) = Sh.Range("D8")
End If
'Here the rest of the process (Iw, 4 till Iw, 125)
'The process also includes a few variations:
'Something like 20 of those with various text
If Sh.CheckBoxes("Check Box 1").Value = 1 Then Cells(Iw, 40) = "Declared" Else Cells(Iw, 40) = "-"
'Something like 30 of those with various text
If Sh.Range("H33") = "Issued" Then
Cells(Iw, 42) = "-"
Else
Cells(Iw, 42) = Sh.Range("H33")
End If
'But all in all they are mostly like that
If Sh.Range("C134") = "" Then
Cells(Iw, 126) = "-"
Else
Cells(Iw, 126) = Sh.Range("C134")
End If
Iw = Iw + 1
EndConsolidation:
Next Sh
End Sub
Try adding this code to your For loop at the end:
If (WorksheetFunction.CountIf(Range("D" & Iw & ":DV" & Iw), "-") = 123) Then
Cntr = Cntr + 1 'Blank sheet found
Else
Cntr = 0 'Not blank - Restart counter
End If
If (Cntr = 10) Then Exit For
This counts the number of - in your row and if it equals 123 (D-DV) then it increments the counter otherwise it clears the counter. When Cntr reaches 10 it exits the loop.
HTH
Add this code before your For loop ends
Dim counter As Integer
Dim previousRowBlank As Boolean
counter = 0
previousRowBlank = True
'count if all the 123 cells contain - string
If (WorksheetFunction.CountIf(Sheets("Summary").Range("D" & Iw & ":DV" & Iw), "-") = 123) Then
If (counter = 0) Then
counter = counter + 1
previousRowBlank = True
Else
If (previousRowBlank = True) Then
counter = counter + 1
End If
End If
Else
previousRowBlank = False
counter = 0
End If
'assuming you want to exit when 10 consecutive rows are blank
If (counter = 10) Then
Exit Sub
End If
When I have something like this I Dim a Boolean variable (perhaps call it isPopulated) which only gets switched to true when one of the cells has a value to act on. Then for your case after 10 (or however many you choose) lines, insert an If isPopulated = False Then Exit For to skip the remaining sheets.
EDIT; another idea I just had for you - if all the cells you're checking are supposed to have numeric values then you could use the below;
If Not WorksheetFunction.Concat(Range("D8"), Range("C134"), etc) Like "*#*" Then
'Code here to skip this and remaining sheets.
Obviously you'd need to add the relevant ranges inside the concat() brackets. What that will do is join the contents of those cells together, then check the result for any numbers "*#*" (you could also check for any letters using "*?*"). That gives you a one-code-line answer to the basic question 'is this sheet populated or not'.
I'm sure it's a bad idea to terminate the macro prematurely, based on such an imprecise criterion as the number of "empty" sheets in series. If data starts again on the 11th, 15th or 30th sheet, then you will not process it, you will lose it.
Your macro is not very complex, it shouldn't take longer than a few seconds. For modern Excel, 25K cells are very few
Your code can be shortened a little, simplified. After all, you know all the addresses of the cells that you need to check on each sheet, you enter them in the macro code sequentially, right? Write them on one line separated by commas and put them in a constant.
After that, the whole code will become much shorter:
Sub SummaryMacro()
Const REQUIRED_CELLS_ADDRESS As String = "D8,...<all other source cells>...,B6"
Const SUM_SHEETNAME As String = "Summary"
Dim ws As Worksheet
Dim wsSum As Worksheet
Dim rCell As Range
Dim oTargetCell As Range
Dim oSumCell As Range
Dim aAddress As Variant
Dim i As Integer
aAddress = Split(REQUIRED_CELLS_ADDRESS, ",")
Set wsSum = ActiveWorkbook.Worksheets(SUM_SHEETNAME)
wsSum.UsedRange.Offset(1, 0).ClearContents
Set oTargetCell = wsSum.Range("A1")
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> SUM_SHEETNAME Then
Set oTargetCell = oTargetCell.Offset(1, 0)
wsSum.Hyperlinks.Add Anchor:=oTargetCell, Address:="", SubAddress:="'" & ws.Name & "'" & "!" & "A1", TextToDisplay:="Go to"
oTargetCell.Resize(1, 123).Value = "-"
Set oSumCell = oTargetCell.Offset(0, 1)
oSumCell.Value = ws.Name
For i = LBound(aAddress) To UBound(aAddress)
Set rCell = ws.Range(aAddress(i))
Set oSumCell = oSumCell.Offset(0, 1)
If Not IsEmpty(rCell) Then oSumCell.Value2 = rCell.Value2
Next i
End If
Next ws
End Sub
Update Everyone knows that working with an array in RAM is much faster than working with sheet cells. Therefore, the outer loop - iterating over the sheets of the book - remains the same, but we change the code inside the loop in this way:
Sub SummaryMacro()
Const SUM_SHEETNAME As String = "Summary"
Dim ws As Worksheet
Dim wsSum As Worksheet
Dim oTargetCell As Range
Dim aResData As Variant
aAddress = Split(REQUIRED_CELLS_ADDRESS, ",")
Set wsSum = ActiveWorkbook.Worksheets(SUM_SHEETNAME)
wsSum.UsedRange.Offset(1, 0).ClearContents
Set oTargetCell = wsSum.Range("A1")
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> SUM_SHEETNAME Then
Set oTargetCell = oTargetCell.Offset(1, 0)
wsSum.Hyperlinks.Add Anchor:=oTargetCell, Address:="", SubAddress:="'" & ws.Name & "'" & "!" & "A1", TextToDisplay:="Go to " & ws.Name
aResData = validateData(ws.Range("A1:L140").Value2) ' Or "D8:C134" or any other
oTargetCell.Offset(0, 1).Resize(1, UBound(aResData) + 1).Value = aResData
End If
Next ws
End Sub
The main trick is hidden in this line aResData = validateData(ws.Range("A1:L140").Value2)
We call our function and pass it as a parameter an array of cell values from the entire next sheet. Further work on analysis and processing will be carried out with the elements of this array. However, this is not the whole trick.
The validateData() function is very simple and looks like this:
Function validateData(aD As Variant) As Variant
validateData = validateValues(aD(1, 5), aD(2, 8), aD(3, 1), aD(2, 11), _
........ , _
aD(111, 3), aD(112, 8), aD(123, 9), aD(126, 10))
End Function
In other words, we select from the entire large array of aD (the name is deliberately made short, because in this function it will have to be repeated 123 times) only those values that need to be analyzed and we pass on to the next function. Despite the seeming simplicity, this is the most time-consuming part - you need to select from the sheet all cells "D8", "C134", etc. and write down their coordinates (row, column) as numbers aD(4,8), aD(3,134), etc.
Perhaps can help in this the mode R1C1 of displaying the sheet. Or some kind of helper function that will be used when preparing the code (not when executing - we agreed that we will no longer access cells for get values or for .Row and .Column properties!)
What will the validateData() function get? A long one-dimensional array aData(0 To 122) of cell values in the listed order. That is, as many values as there are cells to be filled in the Summary row for this sheet.
The last trick is the process of processing values. It would seem that we have gained nothing from all these transformations. But you claim that there are three groups of checks - for an empty value, for a boolean value (checkbox) and for text lines. This is how it is handled:
Function validateValues(ParamArray aData() As Variant) As Variant
Dim i As Variant
Dim aResult As Variant
ReDim aResult(LBound(aData) To UBound(aData))
For i = LBound(aData) To UBound(aData)
Select Case i
Case 1, 5, 7, 9 ' Checking cells empty / value
aResult(i) = IIf(aData(i) = "", "-", aData(i))
Case 4, 6, 10 ' Checking cells boolean True / "not True" (False or blank)
aResult(i) = IIf(aData(i), "Declared", "-")
Case 0, 3, 8 ' Checking cells string "Issued" / other
aResult(i) = IIf(aData(i) = "Issued", "-", aData(i))
Case 2, 91, 118 ' Checking cells string "Pending" / other
aResult(i) = IIf(aData(i) = "Issued", "-", aData(i))
Case Else ' In a real macro, this line is not needed, it will never be executed because all the cells of the array are already listed above, this is useful only for debugging while all conditions will be written
aResult(i) = "-"
Debug.Print "Cell #" & i & " not processed yet"
End Select
Next i
validateValues = aResult
End Function
And now - again, in just one call! - we write a whole row of results:
oTargetCell.Offset(0, 1).Resize(1, UBound(aResData) + 1).Value = aResData
I am sure that these tricks will reduce the time it takes to form the summary sheet many times over. Please try this and let me know if it gets better?
Due to beginner for VBA, I am in a difficult to find this codes.
I need to create 'Command Button' to insert formula according to
current cell location.
Eg. If current cell location is S7, need to get formula in to it '=K7*L7'.
Current cell location change all the time. Multiplication of Column K and L fixed.
Please help me to write this codes.
You can assign below code to command button
Sub Insert_Formula
n = Selection.row
Selection.Value = "=K" & n & "*L" & n
End Sub
In VBA, Selection will get the selected cell properties.
For example, if you select S7,
n = Selection.Row
Then n will be 7
Selection.Value = "=K" & n & "*L" & n
Above will set selected cell's formulat to =K7*L7
In addition, if you want the button to work on selected range which is more than one cell,
Private Insert_Formula_Multi_Cells
For X = 1 To Selection.Rows.Count
n = Selection.Row + X - 1
Selection.Range(Cells(X, 1), Cells(X, Selection.Columns.Count)) = "=K" & n & "*L" & n
Next X
End Sub
Selection.Rows.Count Gets number of rows selected.
Selection.Columns.Count gets number of columns selected
to get current location in excel you can use ActiveCell.Address command.
Below code first gets current selected cells address and then multiplies with K(11) and L(12) columns to print value in active cell.
Sub acell()
Dim s As String
s = ActiveCell.Address
Range(s).Select
Range(s).Value2 = Cells(2, 11) * Cells(2, 12)
Debug.Print s
End Sub
You can add them in loop as per your requirement.
I have one column of data with either "UP", "DOWN" or "" as values. I am trying to write code that states that for all rows, if the first cell is "UP" then check the next rows until I come to either "DOWN" or "UP", i.e. if the next row has a "" then check the next row until I come to either a "DOWN" or "UP".
I am very new to VBA, and have tried various options, but seem to only be able to bring back where there are consecutive "UP"s or "DOWNS" rather than where there is an "UP", a number of rows of "" and then another "UP".
This is my code:
Range("z1:z250").Select
Selection.ClearContents
For Row = 2 To 250
If Range("Y" & Row).Value = "UP" Then
For sRow = 3 To 250
If Range("Y" & Row + 1).Value = "UP" Then
Range("Z" & Row) = "MT-UP"
ElseIf Range("Y" & Row + 1).Value = "" Then
End If
Next
End If
Next
End Sub
I have tried to add code such as For Each c in Range (“Y3”:”Y250”) but this doesn't make it find the next UP, and makes it very slow. I have also tried GoTo next cell (although seem to understand this is frowned upon!) but this doesn't work either. Any help appreciated.
Not 100% clear if this is what you want but take a look...
Instead of nested loops I used a flag to mark when a second consecutive "UP" was found before encountering a "DOWN". From your description it seems there's no need to check for empty cells ("").
Sub MTTest()
Dim Row As Long
Dim MTRow As Long
Dim MTFlag As Boolean
Range("Z1:Z250").ClearContents
For Row = 2 To 250
If Range("Y" & Row).Value = "UP" Then
If MTFlag = True Then
Range("Z" & MTRow) = "MT-UP"
MTFlag = Flase
Else
MTFlag = True
MTRow = Row
End If
Else
If Range("Y" & Row).Value = "DOWN" Then MTFlag = False
End If
Next
End Sub
I have the below code in vba. The rows in sheet5 from columns a5 to a20 are:
a5=Sweden
a6=Spain
a7=Russia
a8=Italy
a9=Germany
a10=Finland
a11=Norway
a12=Switzerland
a13=France
a14=Belgium
Set fillcolumnrange = Sheet5.Range("A5:A20")
i = 1
For Each Row In fillcolumnrange.Rows
If Not Sheet5.Range("A" & i + 4) = "" Then
MsgBox Row(i)
End If
i = i + 1
Next Row
But this code is prompting only alternate values ie.
Sweden
Russia
Germany
Norway
France
Can anyone please help me out find the bug in the code
You were looping through the rows in your range and also advancing the variable i within your loop.
You can reference each variable that you are looping through.
Try this
Set fillcolumnrange = Sheet1.Range("A5:A20")
For Each cell In fillcolumnrange.Cells
If Not cell = "" Then
MsgBox cell
End If
Next cell
You've got a mixture of different types of loop.
Either do what Rick says.
Or use i:
Set fillcolumnrange = Sheet5.Range("A5:A20")
For i = 1 To fillcolumnrange.Rows.Count
If Not Sheet5.Range("A" & i + 4) = "" Then
MsgBox Sheet5.Cells(i + 4, 1)
End If
Next i
Or maybe a do-Loop
Set fillcolumnrange = Sheet5.Range("A5:A20")
i = 1
do until i = fillcolumnrange.Rows.Count + 4
If Not Sheet5.Range("A" & i + 4) = "" Then
MsgBox Sheet5.Cells(i + 4, 1)
End If
i=i+1
Loop
(EDIT now tested and seem to run ok)
Building on Rick's answer, here's the short version of the For Each loop:
For Each cell in fillcolumnrange.Cells
If len(cell) <> 0 Then MsgBox cell
Next