Hey, guys! I came here last year while learning about vba. Lots of great information here! I have a macro that is adding millions of blanks. I added a sub that would delete the blank rows, which works great. However, my customer is wondering if the macro could be sped up. I'm still learning VBA and I inherited this code, so I'm trying my best not to change a whole lot a wreck the whole thing. Basically, I just want to stop the macro from adding blanks in the first place, rather than adding more code that deletes the blank rows AFTER the fact (which I feel would slow down the macro's speed).
Here's the main code that I'm working with:
Here's the main code that I'm working with:
Code:
[/COLOR][COLOR=#333333]Sub Main()[/COLOR]
<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;">
Dim strMacroRunSheet As String
Dim strFirstDataCol As String
Dim strLastDataCol As String
Dim LastRow As Long
Dim strSheetName As String
Dim formulaColNo As Integer
Dim formulaColLetter As String
Dim NumSelectedCols As Integer
Dim DataVersion As String
Application.ScreenUpdating = False
Application.DisplayAlerts = True
Application.StatusBar = "Move, Add and Delete Macro Running"
NumSelectedCols = 0
DataVersion = ""
' Give the user some indication that processing is happening
progressbar.SetMaxValue (10)
progressbar.SetCurrentValue (1)
progressbar.UpdateLabel ("Processing...")
progressbar.Repaint
progressbar.Show
' Get the active sheet name
strSheetName = ActiveSheet.name
strMacroRunSheet = ActiveSheet.name
If ActiveSheet.AutoFilterMode Then
'MsgBox "AutoFilter: on"
Cells.AutoFilter
Else
'MsgBox "AutoFilter: off"
End If
'Determine Format Col [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] and the last format column
Dim FirstFormatCol As Integer
FirstFormatCol = 0
Dim LastFormatCol As Integer
LastFormatCol = 0
For lItem = 0 To frmMAD.ListBox1.ListCount - 1
If frmMAD.ListBox1.Selected(lItem) = True Then
NumSelectedCols = NumSelectedCols + 1
strColName = (frmMAD.ListBox1.List(lItem))
'MsgBox ("Scanning column: " & strColName)
If IsNumeric(Left(strColName, 1)) Then
'MsgBox ("Numeric column name was detected...")
If FirstFormatCol = 0 Then
'MsgBox ("and if we don't have a FirstFormatCol value yet...")
If (InStr(strColName, "N/A") > 0) Then
'MsgBox ("ELSE CONDITION HIT BECAUSE N/A WAS PRESENT")
Else
'MsgBox ("N/A not detected, so setting FirstFormatCol to " & lItem)
FirstFormatCol = NumSelectedCols
End If
End If
LastFormatCol = NumSelectedCols
End If
End If
Next
'MsgBox ("Testing first: " & FirstFormatCol & " which is column " & ConvertToLetter(FirstFormatCol))
'MsgBox ("Testing last: " & LastFormatCol & " which is column " & ConvertToLetter(LastFormatCol))
If FirstFormatCol = 0 Then
' Working on adding SM Mode support for add/delete/move, as well. version 1.91
If frmMAD.chbMove = True Then
MsgBox ("This processing is only allowed for add, delete, pivot and pivot modes. Not allowed for move processing.")
GoTo END_OF_THE_LINE
Else
MsgBox ("No band formats were selected. Attempting processing...")
FirstFormatCol = 1
LastFormatCol = 7
End If
Else
Dim TempString As String
Dim iLocator As Integer
iLocator = 0
TempString = frmMAD.ListBox1.List(FirstFormatCol - 1)
iLocator = InStr(TempString, "SC ESS") - 3
If iLocator > 0 Then
DataVersion = Mid(TempString, 1, iLocator)
Else
iLocator = InStr(TempString, "SC HK1") - 3
If iLocator > 0 Then
DataVersion = Mid(TempString, 1, iLocator)
Else
iLocator = InStr(TempString, "SC HK2") - 3
If iLocator > 0 Then
DataVersion = Mid(TempString, 1, iLocator)
Else
If frmMAD.chbOwnerPivot = True Or frmMAD.chbUserPivot = True Then
MsgBox ("Unable to determine data version by scanning the selected format data. Table generation will possibly be in invalid.")
Else
MsgBox ("WARNING: Unable to determine data version by scanning the selected format data.")
End If
End If
End If
End If
End If
formulaColNo = LastColumnInOneRow() + 1
formulaColLetter = ConvertToLetter(formulaColNo)
Cells(1, LastColumnInOneRow() + 1).Select
strFirstDataCol = ConvertToLetter(FirstFormatCol)
strLastDataCol = ConvertToLetter(LastFormatCol)
'MsgBox ("Scanning from " & strFirstDataCol & " to " & strLastDataCol)
If frmMAD.chbADT = False Then
Selection = "Action"
Cells(2, LastColumnInOneRow()).Select
With Sheets(strSheetName)
'get's the true last row of the spreadsheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
With .Range(formulaColLetter & "2:" & formulaColLetter & LastRow)
.Formula = "=IF(AND(COUNTIF(" & strFirstDataCol & "2:" & strLastDataCol & "2" & ",0)>0,OR(COUNTIF(" & strFirstDataCol & "2:" & strLastDataCol & "2" & ",0.1),COUNTIF(" & strFirstDataCol & "2:" & strLastDataCol & "2" & ",1))=TRUE),""Move"",IF(AND(COUNTIF(" & strFirstDataCol & "2:" & strLastDataCol & "2" & ",0)>0,OR(COUNTIF(" & strFirstDataCol & "2:" & strLastDataCol & "2" & ",0.1),COUNTIF(" & strFirstDataCol & "2:" & strLastDataCol & "2" & ",1))=FALSE),""Delete"",IF(AND(COUNTIF(" & strFirstDataCol & "2:" & strLastDataCol & "2" & ",0)=0,OR(COUNTIF(" & strFirstDataCol & "2:" & strLastDataCol & "2" & ",0.1),COUNTIF(" & strFirstDataCol & "2:" & strLastDataCol & "2" & ",1))=TRUE),""Add"",""No Action"")))"
.Value = .Value
End With
End With
End If
progressbar.SetCurrentValue (2)
progressbar.Repaint
If frmMAD.chbAdd = True Then
Application.StatusBar = "Creating Add Sheet"
Call myAction("Add", formulaColLetter, formulaColNo, LastRow, FirstFormatCol, LastFormatCol)
End If
progressbar.SetCurrentValue (3)
progressbar.Repaint
If frmMAD.chbDelete = True Then
Application.StatusBar = "Creating Delete Sheet"
Call myAction("Delete", formulaColLetter, formulaColNo, LastRow, FirstFormatCol, LastFormatCol)
End If
progressbar.SetCurrentValue (4)
progressbar.Repaint
If frmMAD.chbMove = True Or frmMAD.chbSubMove = True Then
Application.StatusBar = "Creating Move Sheet"
Call myAction("Move", formulaColLetter, formulaColNo, LastRow, FirstFormatCol, LastFormatCol)
End If
progressbar.SetCurrentValue (5)
progressbar.Repaint
If frmMAD.chbOwnerPivot = True Then
Application.StatusBar = "Creating Pivot Owner Table"
Call CreateTable(strMacroRunSheet, formulaColLetter, "Owner", DataVersion, FirstFormatCol, LastFormatCol)
End If
progressbar.SetCurrentValue (6)
progressbar.Repaint
Sheets(strSheetName).Select
If frmMAD.chbUserPivot = True Then
Application.StatusBar = "Creating Table"
Call Table(strMacroRunSheet, formulaColLetter, "User", DataVersion, FirstFormatCol, LastFormatCol)
End If
If frmMAD.chbADT = True Then
Application.StatusBar = "Performing Data Test"
Call AllDataTest
End If
'Call DeleteUnused
progressbar.SetCurrentValue (7)
progressbar.UpdateLabel ("Finished Processing")
progressbar.Hide
progressbar.HideDisplay
'progressbar.Unload
Application.ScreenUpdating = True
Application.StatusBar = ""
Application.DisplayAlerts = False
' Eloy wants the form to be reset when we're done processing.
frmMAD.txtSheetNamePrefix = ""
frmMAD.ListBox1.Clear
frmMAD.FilterListBox.Clear
frmMAD.chbAdd.Value = True ' default mode is add mode, now that we're using radio buttons
frmMAD.chbSubMove.Value = False
frmMAD.chbDelete.Value = False
frmMAD.chbMove.Value = False
frmMAD.chbSubMove.Value = False
frmMAD.chbOwnerPivot.Value = False
frmMAD.chbUserPivot.Value = False
frmMAD.chbAddAllFields.Value = False
frmMAD.FilterTextBox.Value = ""
frmMAD.PivotDupsCheckBox.Enabled = False
frmMAD.PivotDupsCheckBox.Value = False
frmMAD.FilteringCheckBox.Value = False
frmMAD.FilterListBox.Enabled = False
frmMAD.OperatorListBox.Enabled = False
frmMAD.FilterTextBox.Enabled = False
frmMAD.FilterOperatorLabel.Enabled = False
frmMAD.FilterTextLabel.Enabled = False
frmMAD.FilterListBox.Visible = False
frmMAD.OperatorListBox.Visible = False
frmMAD.FilterTextBox.Visible = False
frmMAD.FilterOperatorLabel.Visible = False
frmMAD.FilterTextLabel.Visible = False
ThisWorkbook.Saved = False
' Clear Selection on main sheet
Dim sLastSheetName As String
sLastSheetName = ActiveSheet.name
Sheets(1).Select
Range("A1").Select
Sheets(sLastSheetName).Select
END_OF_THE_LINE:
Application.StatusBar = ""
If frmMAD.chbDeleteTemp.Value = True Then
Application.DisplayAlerts = False
Sheets(strSheetName).Delete
Application.DisplayAlerts = True
End If
progressbar.HideDisplay
Range("A2").Select ' A2 instead of A1 because the Legend looks weird with one cell within it highlighted.
MsgBox ("Move, Add, Delete Macro Complete")
End Sub
Function LastColumnInOneRow()
Dim lastcol As Integer
With ActiveSheet
lastcol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
'MsgBox LastCol
'Cells(1, LastCol + 1).Select
'x = ConvertToLetter(LastCol)
LastColumnInOneRow = lastcol
End Function
Function ConvertToLetter(colNum As Integer) As String
Dim d As Integer
Dim m As Integer
Dim name As String
d = colNum
name = ""
Do While (d > 0)
m = (d - 1) Mod 26
name = Chr(65 + m) + name
d = Int((d - m) / 26)
Loop
ConvertToLetter = name
End Function
Sub FilterTheData(filter_col As Integer, SearchValue As String, filterColLetter As String, OperatorSelected As String)
If OperatorSelected = "CONTAINS" Then
SearchValue = Replace(SearchValue, "*", "")
SearchValue = "*" & SearchValue & "*"
End If
Dim TestingLastRow As Long
TestingLastRow = Cells.Find(What:="*", _
after:=Range("A1"), _
lookat:=xlPart, _
LookIn:=xlFormulas, _
searchorder:=xlByRows, _
searchdirection:=xlPrevious, _
MatchCase:=False).Row
If ActiveSheet.AutoFilterMode Then
Selection.AutoFilter
End If
Range(filterColLetter & "2:" & filterColLetter & TestingLastRow).Select
ActiveSheet.Range("$A1:$" & filterColLetter & "$" & TestingLastRow).AutoFilter Field:=filter_col, Criteria1:=SearchValue </code>[COLOR=#333333]End Sub[/COLOR][COLOR=#333333]
