I only want rows to be visible if any of the cells from B9:AF54 and B60:AF129 have values greater than 0.
For example if the whole row has 0 for every corresponding column, I want it hidden. If any cells in the row has a value of 1 or higher, I want them to be visible.
Sub HideRows()
Dim i As Long
Dim j As Long
Dim hide As Boolean
'loop through rows
For i = 9 To 54
hide = True
'loop in the row: B through AF column
For j = 2 To 32
'if we found value greater then zero, then we don't want to hide this row
If Cells(i, j).Value > 0 Then
hide = False
Exit For
End If
Next j
Rows(i).Hidden = hide
Next i
'loop thorugh second range
For i = 60 To 129
hide = True
'loop in the row: B through AF column
For j = 2 To 32
'if we found value greater then zero, then we don't want to hide this row
If Cells(i, j).Value > 0 Then
hide = False
Exit For
End If
Next j
Rows(i).Hidden = hide
Next i
End Sub
Related
Here is an example of what I am trying to accomplish:
I am trying to add an "x" in the next 3 blank cells that are next to a nonblank cell (from left to right). I do not want to overwrite any cells though. As you can see in the first row, only December and January are filled and I did not overwrite February.
Any ideas?
Sub sub1()
Dim irow&, icol&, n&
For irow = 2 To 6 ' rows
n = 0
For icol = 2 To 14 ' columns
If Cells(irow, icol) = "" Then
n = n + 1
If n <= 3 Then Cells(irow, icol) = "x"
Else
n = 0
End If
Next
Next
End Sub
For Each ID In Range("A2:A6") 'Change your range according your ID
For Each cell In ID.EntireRow.Cells 'Check each cell of ID's row
If cell.Value = "" Then
cell.Value = "x"
No = No + 1
Else
No = 0 'Recount
End If
If No = 3 Then Exit For 'stop after mark 3 x
Next
Next
you could use this
Option Explicit
Sub main()
Dim cell As Range, nCols As Long
With ActiveSheet.UsedRange.SpecialCells(xlCellTypeBlanks)
For Each cell In .Cells
nCols = WorksheetFunction.Min(cell.Column - 1, 3)
If Intersect(cell.Offset(, -nCols).Resize(, nCols + 1), .Cells).Count < 4 Then cell.Value = "x"
Next
End With
End Sub
I have a macro that moves row from one sheet to another one once I time the word "Completed" in a certain field.
The problem is that it moves row into a wrong place. I have 212 rows on another worksheet, the next row should be moved row #213 on another sheet, but it moves all the way to the row #654.
Please help me to resove the issue, so each row will move to the next available row on another worksheet.
Here is my VBA code:
Sub Autoupdating()
'Move shipments once completed
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("Scheduled Shipments").UsedRange.Rows.Count
J = Worksheets("Completed Shipments").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Completed Shipments").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Scheduled Shipments").Range("G1:G" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "Completed" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("Completed Shipments").Range("A" & J + 1)
xRg(K).EntireRow.Delete
If CStr(xRg(K).Value) = "Completed" Then
K = K - 1
End If
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub
The problem looks like you aren't resetting J when you move from one worksheet to the next. So if you first sheet had 652 rows, it will place the last row on line 653 (J + 1 = 653). But, when you start moving rows on the second sheet, it will start placing them at 654 (653 + 1 = 654).
Try to add the following part into your into your code, removing the commented lines as shown:
'Your previous code ---^
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "Completed" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("Completed Shipments").Range("A" & J + 1)
'xRg(K).EntireRow.Delete
'If CStr(xRg(K).Value) = "Completed" Then
' K = K - 1
'End If
J = J + 1
End If
Next
'this is the new code ---v
For K = xRg.Count To 1 Step -1
If CStr(xRg(K).Value) = "Completed" Then
xRg(K).EntireRow.Delete
End If
Next K
'end of the new code ---^
Application.ScreenUpdating = True
End Sub
Whenever you are feeling that the code you are writing does not do what it intends to do, it is a good idea to simplify.
In this case, you may split the task into two sub-tasks:
Copy the rows with "Completed" to a specific worksheet
Delete the rows with the word "Completed"
Note that in order to delete rows correctly from a worksheet, it is a better idea to loop from the bottom and not from the top, thus the loop is reversed.
I want to copy the end of the column B and C in worksheet 1
To column B and C in worksheet 2
I have this :
and this is above :
And here is the code
'Copy of "Maintenances" in worksheet 2
n = 58 'start to look row 58
j = 2 'copy in row 2 in worksheet 2
Sheets("1").Select 'select sheet 1
Do While Cells(n, 1) <> "x" 'do for each cells untill there is a "x" in column A
If Cells(n, 1) <> "x" Then 'if column A is empty, then :
Sheets("2").Cells(j, 2) = Sheets("1").Cells(n, 2) '
Sheets("2").Cells(j, 3) = Sheets("1").Cells(n, 3) '
j = j + 1
End If 'fin du if
n = n + 1
Loop 'retourne au do while
I want to copy all row Under "maintenance" in worksheet 2, BUT the row of "maintenance" can change. the problem is not when the row is ending, but when it start. In my code, it copies column B and C between 58 and when there is a "x" in column 1. but I want that the copy start when in column B its "maintenance"
If I understand your question correctly, then you may replace n = 58 'start to look row 58 with the following code to determine the value of variable n as a start row.
Dim WordToFind As String, FirstWord As String
Dim FindWord
WordToFind = "Maintenance"
With Sheets("1").Range("A:C")
Set FindWord = .Find(what:=WordToFind, SearchDirection:=xlNext)
If Not FindWord Is Nothing Then
FirstWord = FindWord.Row
Do
n = FindWord.Row + 1 'The value of n start from the row below "Maintenance"
Exit Do
Loop While Not FindWord Is Nothing And FindWord.Row <> FirstWord
Else
MsgBox "There is no word " & WordToFind
Exit Sub
End If
End With
You can change the value WordToFind depending on a word or string you are looking for.
I have a spreadsheet with 50K values on it.
I want it a code to go through every value and check to see if it ends in a 5 or 0 and if it doesn't not to round to the nearest of the two.
I tried this as my code
Sub Round_flow()
Dim nxtRow As Long, found As Boolean, i As Long, minus As Long, plus As Long, equal As Long, cell As Boolean, f As Integer
nxtRow = 2
found = False
i = Sheet1.Cells(nxtRow, 2)
minus = -2
equal = 0
While Not found 'finds last used row
If (Cells(nxtRow, 2) = "") Then
found = True
Else
nxtRow = nxtRow + 1
End If
Wend
For f = 2 To i
For minus = -2 To 168 Step 5
If ActiveCell.Value <> equal Then
While Not cell
plus = minus + 4
equal = minus + 2
If minus <= ActiveCell.Value <= plus Then
Sheet1.Cells(i, 2).Value = equal
cell = True
End If
Wend
End If
Next minus
Next f
Essentially what I was trying to do is say here is the last row, i want to check every value from i to last filled row to see if it falls between any plus and minus value (+-2 of the nearest 5 or 0) then have whatever activecell.value be replaced by the 0 or 5 ending digit 'equal' which changes with each iteration.
Ok, that seems way too complicated. To round to 5, you just multiply by 2, round, then divide by 2. Something like this will do the trick:
Dim NumberToBeRounded as Integer
Round(NumberToBeRounded *2/10,0)/2*10
*2 and /2 to get it to be rounded to 5, and /10 *10 to make the round function round for less than 0 decimals.
(I have to admit, I don't really understand what your code is trying to do, I hope I didn't completely misunderstand your needs.)
This should do the trick:
Sub Round_flow()
For f = 2 To Cells(1, 2).End(xlDown).Row
Cells(f, 2).Value = Round(Cells(f, 2).Value * 2 / 10) / 2 * 10
Next
End Sub
Cells(1, 2).End(xlDown).Row finds the last used cell, unless you have no data; if that can happen, add some code to check if you have at least 2 rows. Or you can use the Usedrange and SpecialCells(xlLastCell) combo to find the last used row of your table...
Another way:
Sub RoundEm()
Dim wks As Worksheet
Dim r As Range
Dim cell As Range
Set wks = ActiveSheet ' or any other sheet
On Error Resume Next
Set r = wks.Cells.SpecialCells(xlCellTypeConstants, xlNumbers)
On Error GoTo 0
If Not r Is Nothing Then
For Each cell In r
cell.Value2 = Round(cell.Value2 / 5, 0) * 5
Next cell
End If
End Sub
I am trying to get the below code to work. I would like to count blank cells for columns 1 to 50 in each worksheet. The below works, but it counts for the entire column. How can I change it to only count the first 10 rows in each column and if they are all blank, then change the column width to 1?
Many thanks
For j = 1 To 50
Blanks = WorksheetFunction.CountBlank(Worksheet.Columns(j))
If Blanks > 10 Then
ws.Columns(j).ColumnWidth = 1
End If
Next j
If you only want to check the first 10 rows you need to specify this in your CountBlank function. Your CountBlank(Worksheet.Columns(j)) is counting the entire column.
Also, your If Blanks > 10 Then will never evaluate to True as you only want to count 10 rows. I've changed that expression to If Blanks = 10.
Sub countTest()
Dim wks As Worksheet
Set wks = Worksheets("Sheet1")
For j = 1 To 50
Blanks = WorksheetFunction.CountBlank(wks.Range(Cells(1, j), Cells(10, j)))
If Blanks = 10 Then
wks.Columns(j).ColumnWidth = 1
End If
Next j
Set wks = Nothing
End Sub
Try something like this:
Dim i As Integer
Dim j As Integer
Dim k As Integer
For i = 1 To 50
k=0
For j = 1 to 10
If Activesheet.Cells(j,i).Value = "" Then
k=k+1
End If
Next j
If k = 10 Then
Activesheet.Columns(i).ColumnWidth = 1
End If
Next i
Let me know if there are any issues with it.