I have a spreadsheet (Sheet3) which collects and sorts data from 25 other sheets. So I don't have a ton of empty rows in Sheet3 I do a VBA loop that first checks to see if a sheet is visible, then it hides and unhides rows based on whether or not they are hidden in the 25 other sheets, like so:
Sheet3.Rows("1791:9290").EntireRow.Hidden = True
For i = 1205 To 1354
If Sheet1.Visible = True Then
If Sheet1.Rows(i).EntireRow.Hidden = False Then
Sheet3.Rows(i + 586).EntireRow.Hidden = False
End If
End If
If Sheet2.Visible = True Then
If Sheet2.Rows(i).EntireRow.Hidden = False Then
Sheet3.Rows(i + 886).EntireRow.Hidden = False
End If
End If
If Sheet4.Visible = True Then
If Sheet4.Rows(i).EntireRow.Hidden = False Then
Sheet3.Rows(i + 1186).EntireRow.Hidden = False
End If
End If
etc...
Due to the type of data I need to pull I unfortunately can't match sheet 3 up with the other 25 sheets row for row. For each row visible in the other 25 sheets, I need Sheet3 to unhide 2 rows.
For example, if SheetX Row 1 is visible, Sheet3 must make rows 1 and 2 visible. If SheetX Row 2 is visible, Sheet 3 must make rows 3 and 4 visible, and so on.
Is there any way to do this outside of me having to change all of the 25 other sheets to double their row count? This is only one part of a huge project and I'd prefer not to add a few thousand more rows if it can be avoided.
Use .Cells and resize to 2 rows in height before applying .EntireRow.
Sheet3.Cells(i + 586, 1).Resize(2, 1).EntireRow.Hidden = False
The Resize property will adjust the height of the range being referenced. The subsequent Range.EntireRow property continues the change in cell reference to include the entire row.
I realized that the only way to do this was to add another integer that would change each time through the loop. So I added Dim J As Integer and set j = 0. I added a line to unhide two rows through each loop and incorporated j into that code. Then I added j = j + 1 to the end of the loop.
So here's how it looks:
Dim j As Integer
j = 0
Sheet3.Rows("1791:9290").EntireRow.Hidden = True
For i = 1205 To 1354
If Sheet1.Visible = True Then
If Sheet1.Rows(i).EntireRow.Hidden = False Then
Sheet3.Rows(i + j + 586).EntireRow.Hidden = False
Sheet3.Rows(i + j + 587).EntireRow.Hidden = False
End If
End If
If Sheet2.Visible = True Then
If Sheet2.Rows(i).EntireRow.Hidden = False Then
Sheet3.Rows(i + j + 886).EntireRow.Hidden = False
Sheet3.Rows(i + j + 887).EntireRow.Hidden = False
End If
End If
If Sheet4.Visible = True Then
If Sheet4.Rows(i).EntireRow.Hidden = False Then
Sheet3.Rows(i + j + 1186).EntireRow.Hidden = False
Sheet3.Rows(i + j + 1187).EntireRow.Hidden = False
End If
End If
etc...
j = j + 1
Next
Related
I have a spreadsheet of products, which are in particular fonts and backgrounds. I am trying to create a macro so when I perform the find function (CLTR-F), I can click a macro button which will copy my selection, and paste it into the first available cell in Row N starting with the second row ("N2") and ending with the 12th row ("N12").
I have more data in N, for example in N13 and N14, so I cannot simply count the rows occupied and add one. I want to make this code work so this process exits once the first cell has been pasted into. Currently my code simply pastes the selected cell into both N2 and N3. The goal is that once the value is pasted, the process ends. But if the value is not pasted, it will go onto the next available cell and paste, and end, and so on if the cells are occupied until it is pasted in the first empty cell. Below is what I have, and so far it pastes into both N2 and N3, (If N2 is not occupied.)
Sub CopyPasteFirstEmptyCell()
'Copy the selection
Selection.Copy
'Test for N2
If IsEmpty(Range("N2")) = True Then
Selection.Copy Range("N2")
End If
'Test for N3
If IsEmpty(Range("N2")) = True Then
Selection.Copy Range("N3")
'Test For N4-N12 etc. etc.
End Sub
Thank you so kindly for listening. I have looked at relevant threads and have not found a sufficient answer of yet, and I apologize if that answer already exists openly.
I created variables and added them to a final variable to decide the range.
Sub Copy()
'Copy the selection
Selection.Copy
'Create variables
Dim intN2 As Integer
Dim intN3 As Integer
Dim intN4 As Integer
Dim intN5 As Integer
Dim intN6 As Integer
Dim intN7 As Integer
Dim intN8 As Integer
Dim intN9 As Integer
Dim intN10 As Integer
Dim intN11 As Integer
Dim intN12 As Integer
Dim finalint As Integer
'Create If Then statements to increaes finalint
'For N2
If IsEmpty(Range("N2")) = True Then
intN2 = 0
ElseIf IsEmpty(Range("N2")) = False Then
intN2 = 1
End If
'For N3
If IsEmpty(Range("N3")) = True Then
intN3 = 0
ElseIf IsEmpty(Range("N3")) = False Then
intN3 = 1
End If
'For N4
If IsEmpty(Range("N4")) = True Then
intN4 = 0
ElseIf IsEmpty(Range("N4")) = False Then
intN4 = 1
End If
'For N5
If IsEmpty(Range("N5")) = True Then
intN5 = 0
ElseIf IsEmpty(Range("N5")) = False Then
intN5 = 1
End If
'For N6
If IsEmpty(Range("N6")) = True Then
intN6 = 0
ElseIf IsEmpty(Range("N6")) = False Then
intN6 = 1
End If
'For N7
If IsEmpty(Range("N7")) = True Then
intN7 = 0
ElseIf IsEmpty(Range("N7")) = False Then
intN7 = 1
End If
'For N8
If IsEmpty(Range("N8")) = True Then
intN8 = 0
ElseIf IsEmpty(Range("N8")) = False Then
intN8 = 1
End If
'For N9
If IsEmpty(Range("N9")) = True Then
intN9 = 0
ElseIf IsEmpty(Range("N9")) = False Then
intN9 = 1
End If
'For N10
If IsEmpty(Range("N10")) = True Then
intN10 = 0
ElseIf IsEmpty(Range("N10")) = False Then
intN10 = 1
End If
'For N11
If IsEmpty(Range("N11")) = True Then
intN11 = 0
ElseIf IsEmpty(Range("N11")) = False Then
intN11 = 1
End If
'For N12
If IsEmpty(Range("N12")) = True Then
intN12 = 0
ElseIf IsEmpty(Range("N12")) = False Then
intN12 = 1
End If
'Make finalint the total of all other integers
finalint = intN2 + intN3 + intN4 + intN5 + intN6 + intN7 + intN8 + intN9 + intN10 + intN11 + intN12
'Place selection depending on amount of finalint
If finalint = 0 Then
Selection.Copy Range("N2")
ElseIf finalint = 1 Then
Selection.Copy Range("N3")
ElseIf finalint = 2 Then
Selection.Copy Range("N4")
ElseIf finalint = 3 Then
Selection.Copy Range("N5")
ElseIf finalint = 4 Then
Selection.Copy Range("N6")
ElseIf finalint = 5 Then
Selection.Copy Range("N7")
ElseIf finalint = 6 Then
Selection.Copy Range("N8")
ElseIf finalint = 7 Then
Selection.Copy Range("N9")
ElseIf finalint = 8 Then
Selection.Copy Range("N10")
ElseIf finalint = 9 Then
Selection.Copy Range("N11")
ElseIf finalint = 10 Then
Selection.Copy Range("N12")
End If
End Sub
Between columns F and BM of the sheet, if any value within those columns is equal to "NULL" then don't hide, otherwise hide that column, the column before and column after. The loop should evaluate every other 3rd starting at column G and ending at column BM.
For example, if column G contains the value "NULL" then do nothing and go to column J (three columns forward). If column J now has no cells with value NULL then hide that column, the column before (column I), and the column after (column K).
This is what Im having trouble with. I am able to hide a column based on if the column contains the value NULL or not.
This is the code variations that I have attempted.
Sub SuspenseReport()
Dim allColumns As Range
Dim cell As Range
Dim col As Range
Dim x As Integer
Dim i As Integer
Application.ScreenUpdating = False
Set allColumns = Columns("C:E")
allColumns.Hidden = True
Set allColumns = Columns("BN:DY")
allColumns.Hidden = True
Set allColumns = Columns("EB:EU")
allColumns.Hidden = True
Dim rng1 As Range: Set rng1 = Application.Range("G2:BO8") 'maybe limit the range to just one column and range.offet at the end?
For Each col In rng.Columns
If cell.Value = "NULL" Then
cell.EntireColumn.Hidden = False
GoTo ExitIfStat
Else: cell.EntireColumn.Hidden = True
End If
Next col
ExitIfStat:
Next x
'below is another variation I attempted but the for loop would iterate on cell not column
'Dim i As Integer
'i = -1
'For Each col In Range("G1:BO8")
' i = i + 1
' If i Mod 3 = 0 Then
' If col.Value = "NULL" Then
' col.EntireColumn.Hidden = False
' Else: col.EntireColumn.Hidden = True
'col.Offset(0, -1).EntireColumn.Hidden = True
'col.Offset(0, 1).EntireColumn.Hidden = True
' End If
Application.ScreenUpdating = True
End Sub
Maybe something like:
Sub HideColumnWithoutNullString()
Dim range, colCount, rowCount, hasNull, rowsToCheck
Dim firstColumn, currentColumn, lastColumn
Set range = Application.range("G:BM")
firstColumn = range.Columns(0).Column
lastColumn = range.Columns(range.Columns.Count).Column
currentColumn = 0
rowsToCheck = 1
For colCount = firstColumn To lastColumn Step 1
hasNull = False
For rowCount = 1 To range.Rows.Count Step 1
If Application.Cells(rowCount, colCount).Value = "NULL" Then
hasNull = True
Exit For
End If
If rowCount >= rowsToCheck Then
Exit For
End If
Next
If Not hasNull Then
range.Columns(currentColumn).Hidden = True
Else
range.Columns(currentColumn).Hidden = False
End If
currentColumn = currentColumn + 1
Next
End Sub
Where rowsToCheck is the number of rows the script has to check for "NULL" on each column, if it only has to check the first row set its value to 1.
This one follows the same logic as Octavio's answer, but will check for an empty column or the value of "NULL".
Sub SuspenseReport()
Dim col As Range
Application.ScreenUpdating = False
Set Rng = Application.Range("G2:BO8")
vLr = ActiveCell.SpecialCells(xlLastCell).Row
For Each col In Rng.Columns
vFlag = False
For vrow = 2 To vLr
vX = Cells(vrow, col.Column).Value
If vX = "" Or vX = "NULL" Then
vFlag = True
End If
Next
If vFlag Then
col.EntireColumn.Hidden = False
Else
col.EntireColumn.Hidden = True
End If
Next col
Application.ScreenUpdating = True
End Sub
I'm having troubles with my loop. I want to make a worksheet, print it (not build in yet, I know how it works), then delete it. After that proceed to the next j to do the same. But it is relooping the j = 1 to 1, so it's trying to create a second worksheet named "print" and that's not possible.
I have checkboxes with name: CheckBox1, CheckBox2, CheckBox'j'. I want to start with CheckBox1 and end with CheckBox25. If it's true then print the sheet.
I think I need to get rid of the first For:
For Each ctrl In Me.Controls
But I don't know how. Because I need it to specify the variable 'j'.
Private Sub PrintKnop_Click()
Dim ctrl As MSForms.Control
For Each ctrl In Me.Controls
If TypeName(ctrl) = "CheckBox" And Left(ctrl.Name, 8) = "CheckBox" Then
Dim j As Integer
j = Mid(ctrl.Name, 9, 2)
For j = 1 To 1
'it should be possible to adjust the range.
If ctrl.Value = True Then
Dim ws As Worksheet
With ThisWorkbook
Worksheets("Veiligheid").Copy _
before:=ActiveWorkbook.Sheets("Data")
Set ws = ActiveSheet
ws.Name = "print"
End With
'Application.DisplayAlerts = False
'Sheets("print").Delete
'Application.DisplayAlerts = True
'These shouldn't be comments, but if I uncomment it, it won't show the failures.
End If
Next
For j = 2 To 4
If ctrl.Value = True Then
With ThisWorkbook
Worksheets("Veiligheid").Copy _
before:=ActiveWorkbook.Sheets("Data")
Set ws = ActiveSheet
ws.Name = "printen"
End With
'Application.DisplayAlerts = False
'Sheets("printen").Delete
'Application.DisplayAlerts = True
End If
Next
End If
Next
End Sub
One problem I see here is that you are using the variable j multiple times.
j = Mid(ctrl.Name, 9, 2)
...
For j = 1 to 1
...
For j = 2 to 4
...
The line j = Mid(ctrl.Name, 9, 2)
will assign some value to j.
The line For j = 1 to 1 will set j = 1 and loop one time.
The line For j = 2 to 4 will set j = 2 and increment j each loop (runs three times)
Are you sure it is looping on For j = to 1 loop and not just moving on to the second loop?
Sub test()
j = 2 + 3
Debug.Print j
For j = 99 to 99
Debug.print j
Next
For j = 2 to 4
Debug.print j
Next
End Sub
This outputs values 5, 99, 2, 3, 4
It might be more obvious when the values are out of numerical order.
It looks like you have repeating operations in the loop and you are looking for switch-like operation. I guess you mean to parse the number of the CheckBox as the variable j. When you get it, the rest of the loop is something like:
... Prepare variables for this loop round ...
If j = 1 Then
... do something ...
Else
... do something else ...
End If
... Put here the part that stays the same regardless the j value ...
And no For-loop is needed in this section.
You may be confusing your For j = loop with if j =
for j = will set your variable equal to the value following it
you'd probably be better off with a select case j statement
Private Sub PrintKnop_Click()
Dim ctrl As MSForms.Control
For Each ctrl In Me.Controls
If TypeName(ctrl) = "CheckBox" And Left(ctrl.Name, 8) = "CheckBox" And ctrl.Value = True Then
Dim j As Integer
j = Mid(ctrl.Name, 9, 2)
Select Case j
Case 1
'it should be possible to adjust the range.
Dim ws As Worksheet
With ThisWorkbook
Worksheets("Veiligheid").Copy _
before:=ActiveWorkbook.Sheets("Data")
Set ws = ActiveSheet
ws.Name = "print"
End With
'Application.DisplayAlerts = False
'Sheets("print").Delete
'Application.DisplayAlerts = True
'These shouldn't be comments, but if I uncomment it, it won't show the failures.
Case 2 To 4
With ThisWorkbook
Worksheets("Veiligheid").Copy _
before:=ActiveWorkbook.Sheets("Data")
Set ws = ActiveSheet
ws.Name = "printen"
End With
'Application.DisplayAlerts = False
'Sheets("printen").Delete
'Application.DisplayAlerts = True
End Select
End If
Next
End Sub
You have 2 loops for same J. If you need your code different things for different J value, I think this solution might help:
ja = ja&"|"&Mid(ctrl.Name, 9, 2)
j = split(ja,"|")
for i = 0 to uBound(j)
if cInt(j(i))=1 then do something
if j(i)>1 AND j(i)<5 then do something 'j=2,3,4
if j(i)>4 AND j(i)<26 then do something 'j=5-25
next
BUT the Mid(ctrl.Name, 9, 2) means you are having TWO symbols, and for CheckBox1 it is "x1", NOT "1". That means, in your code j is x1.
You need to rename your checkboxes to two-digit index, like "CheckBox01"
OR, you might add one line more:
j = Mid(ctrl.Name, 9, 2)
IF LEFT(j,1)="x" then j=RIGHT(j,1)
For j = 1 to 25
if j = 1 then....
if j >1 then...
next
This allows you to have only 1 from x1
EDIT
Just noticed, that length of "CheckBox1" is 9. You might need to get the checkbox number from right 2 symbols:
j = RIGHT(ctrl.Name,2)
And, get rid of "x":
IF LEFT(j,1)="x" then j=RIGHT(j,1)
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
I have a userform in which a user will check all items they want a group of pivot tables filtered on. The issue is I have about 40 pivot tables and over 250 options the user can filter on. Ideally, I planned to set the pivot table filter to an array of values, but I cannot find a solution that avoids looping through the array and filter options. Please find my code below. Any optimization advice is greatly appreciated. Thank you!
Private Sub Filter_btn_Click()
Dim i As Integer
Dim n As Integer
Dim filter_num As Integer
Dim pivot_num As Integer
Dim MyArray() As String
Dim pt As PivotTable
Application.ScreenUpdating = False
Set dashboard = Sheets("Dashboard")
'Adding all selected items to array
n = 0
For i = 0 To Supplier_Listbox.ListCount - 1
If Supplier_Listbox.Selected(i) = True Then
ReDim Preserve MyArray(n)
MyArray(n) = Supplier_Listbox.List(i)
n = n + 1
End If
Next
i = 0
For pivot_num = 1 To 41
Set pt = dashboard.PivotTables("PivotTable" & pivot_num)
filter_num = 0
With pt.PivotFields("FilterItems")
'Include first item in filter to avoid error
.PivotItems(1).Visible = True
' PivotItems.Count is 270
For i = 2 To .PivotItems.Count
' Attempted to make the code a little faster with first if statement. Will avoid function if all array items have been checked
If filter_num = n Then
.PivotItems(i).Visible = False
' Call to function
ElseIf IsInArray(.PivotItems(i), MyArray) Then
.PivotItems(i).Visible = True
filter_num = filter_num + 1
Else:
.PivotItems(i).Visible = False
End If
Next
'Check if first item is actually in array, if not, remove filter
If IsInArray(.PivotItems(1), MyArray) Then
.PivotItems(1).Visible = True
Else:
.PivotItems(1).Visible = False
End If
End With
Next
Unload Me
Application.ScreenUpdating = True
End Sub
I ended up filtering the original set of data based on my array and copying and pasting those filtered values to a new table on a different sheet. This new sheet became the source data for my 40 pivot tables. This change created several smaller issues, but now the code runs in <10 seconds compared to 90 seconds. Thank you to everyone that provided suggestions to this issue.
Private Sub Filter_btn_Click()
Dim i As Integer
Dim n As Integer
Dim MyArray() As String
Application.ScreenUpdating = False
Set dashboard = Sheets("Dashboard")
Set Org_data = Sheets("Original Data")
Set Filtered_Data = Sheets("Filtered Data")
'Adding all selected items in userform to array
n = 0
For i = 0 To FilterOptions_Listbox.ListCount - 1
If FilterOptions_Listbox.Selected(i) = True Then
ReDim Preserve MyArray(n)
MyArray(n) = FilterOptions_Listbox.List(i)
n = n + 1
End If
Next
Filtered_Data.Activate
ActiveSheet.ListObjects("Table2").DataBodyRange.Select
Selection.ClearContents
'Copy values filtered on array
Org_data.Activate
Org_data.ShowAllData
With Org_data.Range("A1")
.AutoFilter Field:=2, Criteria1:=MyArray, Operator:=xlFilterValues
End With
ActiveSheet.ListObjects("Table1").DataBodyRange.Select
Selection.Copy
'Paste filtered values
Filtered_Data.Activate
ActiveSheet.ListObjects("Table2").DataBodyRange.Select
Selection.PasteSpecial xlPasteValues
Application.CutCopyMode = False
'Refresh all pivot tables at once
ActiveWorkbook.RefreshAll
dashboard.Activate
Application.ScreenUpdating = True
Unload Me
End Sub