I've been using the code below from jonhaus.hubpages.com to remove the empty columns I have.
'Delete empty columns
Dim c As Integer
c = ActiveSheet.Cells.SpecialCells(xlLastCell).Column
Do Until c = 0
If WorksheetFunction.CountA(Columns(c)) = 0 Then
Columns(c).Delete
End If
c = c - 1
Loop
However, as I've been writing the VBA, it's gotten kinda bloated and slow... I'm trying to optimize and streamline my code by eliminating loops, copy/pastes, etc.
Do y'all have suggestions for code that would do the same thing (deleting entire emtpy columns) WITHOUT requiring looping "Do Until/If/End If/Loop" statements?
References:
http://jonhaus.hubpages.com/hub/Excel-VBA-Delete-Blank-Blank-Columns
http://www.ozgrid.com/VBA/SpeedingUpVBACode.htm
Expanding on my comment above, create the range inside the loop, but delete it only once.
Dim c As Integer
Dim rngDelete As Range
c = ActiveSheet.Cells.SpecialCells(xlLastCell).Column
Do Until c = 0
If WorksheetFunction.CountA(Columns(c)) = 0 Then
'Combine each empty column:
If Not rngDelete Is Nothing Then
Set rngDelete = Application.Union(rngDelete, Columns(c))
Else
Set rngDelete = Columns(c)
End If
End If
c = c - 1
Loop
'Deletes ALL empty columns at once:
rngDelete.EntireColumn.Delete
The other obvious improvements are to disable Application.ScreenUpdating and set Application.Calculation = xlManual during run-time. (remember to restore their normal functionalities at the end of subroutine.
Related
I have a macro that so far, adds 4 new table columns to an existing table ("Table1"). Now, I would like the macro to format the 3rd and 4th row as percentage. I would like to include this in the loop already listed in my code. I have tried several different ways to do this. I don't think I quite understand how the UBound function works, but hopefully you can understand what I am trying to do.
I also am unsure if I am allowed to continue to utilize the WITH statement in my nested For loop in regards to me 'lst' variable.
#Jeeped - I'm looking at you for this one again...thanks for basically walking me through this whole project lol
Sub attStatPivInsertTableColumns_2()
Dim lst As ListObject
Dim currentSht As Worksheet
Dim colNames As Variant, r1c1s As Variant
Dim h As Integer, i As Integer
Set currentSht = ActiveWorkbook.Sheets("Sheet1")
Set lst = ActiveSheet.ListObjects("Table1")
colNames = Array("AHT", "Target AHT", "Transfers", "Target Transfers")
r1c1s = Array("=([#[Inbound Talk Time (Seconds)]]+[#[Inbound Hold Time (Seconds)]]+[#[Inbound Wrap Time (Seconds)]])/[#[Calls Handled]]", "=350", "=[#[Call Transfers and/or Conferences]]/[#[Calls Handled]]", "=0.15")
With lst
For h = LBound(colNames) To UBound(r1c1s)
.ListColumns.Add
.ListColumns(.ListColumns.Count).Name = colNames(h)
.ListColumns(.ListColumns.Count).DataBodyRange.FormulaR1C1 = r1c1s(h)
If UBound(colNames(h)) = 2 or UBound(colNames(h)) = 3 Then
For i = UBound(colNames(h), 2) To UBound(colNames(h), 3)
.ListColumns(.ListColumns.Count).NumberFormat = "0%"
End if
Next i
Next h
End With
End Sub
You don't need to nest a second for loop. If you want to set the 3rd and 4th columns to a percentage, you only need to set that when the iteration of the loop (h) is 2 or 3 (remembering that arrays index from 0). You also shouldn't cross arrays for the main loop, and since LBound is in most cases 0 you might as well just use that anyway. Try this:
With lst
For h = 0 To UBound(r1c1s)
.ListColumns.Add
.ListColumns(.ListColumns.Count).Name = colNames(h)
.ListColumns(.ListColumns.Count).DataBodyRange.FormulaR1C1 = r1c1s(h)
If h = 2 or h = 3 Then
.ListColumns(.ListColumns.Count).NumberFormat = "0%"
End if
Next h
End With
To answer the other point in your question, UBound(array) just gives the index of the largest element (the Upper BOUNDary) in the given array. So where you have 50 elements in such an array, UBound(array) will return 49 (zero based as mentioned before). LBound just gives the other end of the array (the Lower BOUNDary), which is generally zero.
I have code that is designed to loop through each cell in a row and delete them EXCEPT for the A and O columns. When I run this code it only deletes the second column.
I am aware of the "Rows(Target.Row).ClearContents" line but this does not suit my purposes as I need specific columns to stay intact.
Dim i As Integer
For i = 2 To i = 30
If i = 15 Then
'update i but do nothing
i = i + 1
Else
'update i and clear contents of cell
.Cells(Target.Row, i).Clear
i = i + 1
End If
Next
The For loop increments the i so you shouldn't, and this syntax is incorrect For i = 2 To i = 30:
Dim i As Long
For i = 2 To 30
If i <> 15 Then .Cells(Target.Row, i).Clear
Next
A faster way to exclude certain columns from the row (without using a loop):
With Target.Parent
.Columns(15).Hidden = True
.UsedRange.Rows(Target.Row).SpecialCells(xlCellTypeVisible).Clear
.Columns(15).Hidden = False
End With
Why use loops at all?
Union(Range(.Cells(Target.Row,2),.Cells(Target.Row,14)), Range(.Cells(Target.Row,16),.Cells(Target.Row,30))).Clear
I have 2 sheets: sheet1 and sheet2. I have a value in cell A3 (sheet1) which is not constant. And many files in sheets2.
What I would like to do, is when the value in cell A3 (Sheet1) is the same as the value in the column A (Sheet2), it will delete the entire row where is find this value (Sheet2).
This is my attempt. It doesn't work: no rows are deleted.
If Worksheets("Sheet1").Range("A3").Text = Worksheets("Sheet2").Range("A:A").Text Then
Dim f As String
f = Worksheets("Sheet1").Range("A3")
Set c = Worksheets("Sheet2").Range("A:A").Find(f)
Worksheets("Sheet2").Range(c.Address()).EntireRow.Delete
End If
My guess is that you're not finding anything with the .Find(). Since you're not checking it for is Nothing you don't know. Also, .Find() retains all the search parameters set from the last time you did a search - either via code or by hand in your spreadsheet. While only the What parameter is required, it's always worth setting the most critical parameters (noted below) for it, you may want to set them all to ensure you know exactly how you're searching.
Dim f As String
If Worksheets("Sheet1").Range("A3").Text = Worksheets("Sheet2").Range("A:A").Text Then
f = Worksheets("Sheet1").Range("A3")
Set c = Worksheets("Sheet2").Range("A:A").Find(What:=f, Match:=[Part|Whole], _
LookIn:=[Formula|value])
if not c is Nothing then
Worksheets("Sheet2").Range(c.Address()).EntireRow.Delete
else
MsgBox("Nothing found")
End If
End If
Go look at the MS docs to see what all the parameters and their enumerations are.
Sub Test()
Dim ws As Worksheet
For x = 1 To Rows.Count
If ThisWorkbook.Sheets("Sheet2").Cells(x, 1).Value = ThisWorkbook.Sheets("Sheet1").Cells(3, 1).Value Then ThisWorkbook.Sheets("Sheet2").Cells(x, 1).EntireRow.Delete
Next x
End Sub
If I have a loop that commences:
For each c in Range("A1:C8")
Is there a property of the placeholder c (c.count, c.value, c.something,...) that identifies the number of times the loop has iterated thus far? I would rather use something like this than including another variable.
Instead of using a "for each c in range" you can do something like this:
Dim c as Long 'presumably you did this as a Range, just change it to Long.
Dim myRange as Range 'Use a range variable which will be easier to call on later
Set myRange = Range("A1:C8")
For c = 1 to myRange.Cells.Count
'Do something to the cell, identify it as myRange.Cells(c), for example:
myRange.Cells(c).Font.Bold = True '<--- replace with your code that affects the cell
Next
This allows you to do the exact same For/Next loop, without including an unnecessary counter variable. In this case, c is a counter but also serves the purpose of identifying the cell being impacted by the code.
You need to count it yourself like this
Dim i as integer
i = 0
For each c in Range("A1:C8")
i = i + 1
Or
Dim i as integer
Dim c as Range
For i = 0 to Range("A1:C8").Count - 1
Set c = Range("A1:C8").Cells(i)
(Revised)
Using Column or Row properties, as appropriate to the direction you are iterating, you can compute an ordinal number on the fly. Thus
For Each c1 in myRange
myOrdinal = c1.row - myRange.row + 1 ' down contiguous cells in one column
myOrdinal = c1.Column - myRange.Column + 1 ' contiguous columns, L2R
Next
I'm for a solution to part of a macro I'm writing that will hide certain (fixed position) rows across a few different sheets. I currently have:
Sheets(Sheet1).Range("5:20").EntireRow.Hidden = True
To hide rows 5-20 in Sheet1. I also would like to hide (for arguements sake), row 6, row 21, and rows 35-38 in Sheet2 - I could do this by repeating the above line of code 3 more times; but am sure there's a better way of doing this, just as a learning exercise.
Any help much appreciated :)
Chris
Specify a Union of some ranges as follows
With Sheet1
Union(.Range("1:5"), .Rows(7), .Range("A10"), .Cells(12, 1)).EntireRow.Hidden = True
End With
Here is a try:
Sub hideMultiple()
Dim r As Range
Set r = Union(Range("A1"), Range("A3"))
r.EntireRow.Hidden = True
End Sub
But you cannot Union range from several worksheets, so you would have to loop over each worksheet argument.
This is a crude solution: no validation, no unhiding of existing hidden rows, no check that I have a sheet name as first parameter, etc. But it demonstrates a technique that I often find useful.
I load an array with a string of parameters relevant to my current problem and code a simple loop to implement them. Look up the sub and function declarations and read the section on ParamArrays for a variation on this approach.
Option Explicit
Sub HideColumns()
Dim InxPL As Integer
Dim ParamCrnt As String
Dim ParamList() As Variant
Dim SheetNameCrnt As String
ParamList = Array("Sheet1", 1, "5:6", "Sheet2", 9, "27:35")
SheetNameCrnt = ""
For InxPL = LBound(ParamList) To UBound(ParamList)
ParamCrnt = ParamList(InxPL)
If InStr(ParamCrnt, ":") <> 0 Then
' Row range
Sheets(SheetNameCrnt).Range(ParamCrnt).EntireRow.Hidden = True
ElseIf IsNumeric(ParamCrnt) Then
' Single Row
Sheets(SheetNameCrnt).Range(ParamCrnt & ":" & _
ParamCrnt).EntireRow.Hidden = True
Else
' Assume Sheet name
SheetNameCrnt = ParamCrnt
End If
Next
End Sub