I am trying to hide multiple rows in an excel worksheet which are empty using following code however i am getting error message "Argument not optional". What could be wrong in the code?
Sub Attendance_Manday()
Dim sht1 As Worksheet
Dim row_count, col_count As Integer
Dim mainrange As Range
Dim startcell As Range
Set startcell = Range("B1")
Set sht1 = Sheets("Mandays")
row_count = Sheets("Mandays").Cells(Rows.Count, startcell.Column).End(xlUp).Row
col_count = Sheets("Mandays").Cells(startcell.Row, Columns.Count).End(xlToLeft).Offset(1, -2).Column
Set mainrange = sht1.Range(startcell.Address & ":" & sht1.Cells(row_count, col_count).Address)
mainrange.Range.SpecialCells(xlCellTypeBlanks).Rows.Hidden = True
End Sub
Based on your code and assuming first row in your sheet is never empty you could do something like that
Sub Attendance_Manday()
Dim sht1 As Worksheet
Dim row_count As Long, col_count As Long
Dim mainrange As Range
Dim startcell As Range
Set startcell = Range("B1")
Set sht1 = Sheets("Mandays")
row_count = Sheets("Mandays").Cells(Rows.Count, startcell.Column).End(xlUp).Row
col_count = Sheets("Mandays").Cells(startcell.Row, Columns.Count).End(xlToLeft).Offset(1, -2).Column
Set mainrange = sht1.Range(startcell.Address & ":" & sht1.Cells(row_count, col_count).Address)
Dim i As Long
For i = 1 To col_count - 1
mainrange.AutoFilter field:=i, Criteria1:="="
Next i
Dim rg As Range
Set rg = mainrange.SpecialCells(xlCellTypeVisible)
mainrange.AutoFilter
rg.Rows.EntireRow.Hidden = True
rg.Rows(1).EntireRow.Hidden = False
End Sub
An if you turn off screenupdating etc. it should be pretty fast as well
Related
In the code below, I have identified a range (ColRng) in which I want to check each cell - if it is empty, there is a SUMIFS function to perform. It does not work. I know my syntax and logic is horrid, but I can't figure out how to make it work.
Dim ColRng As Range
Dim LastCol As Long
Dim LastRowScenario As Long
Dim x As Long
Dim rngCrit1 As Range
Dim rngCrit2 As Range
Dim rngSum As Range
LastRowScenario = Sheets("Sheet1").Range("Q2").End(xlDown).Row
Set rngCrit1 = Sheets("Sheet1").Range("D2:D" & LastRowScenario)
Set rngCrit2 = Sheets("Sheet1").Range("B2:B" & LastRowScenario)
Set rngSum = Sheets("Sheet1").Range("Q2:Q" & LastRowScenario)
LastCol = Sheets("Summary").Range("B5").End(xlToRight).Column
Set ColRng = Range(LastCol & "6:" & LastCol & "149")
For x = ColRng.Cells.Count To 1 Step -1
With ColRng.Cells(x)
' If the cell is empty, perform a SUMIFS
If IsEmpty(.Value) Then
.Formula = Application.WorksheetFunction.SumIfs(rngSum, rngCrit1, .Range("E" & .Row).Value, rngCrit2, .Range("B" & .Row).Value)
End If
End With
Next x
Your ColRng construction is wrong - try something like this instead:
Dim ColRng As Range
Dim LastCol As Long
Dim LastRowScenario As Long
Dim x As Long
Dim rngCrit1 As Range
Dim rngCrit2 As Range
Dim rngSum As Range, ws As Worksheet, wsSumm As Worksheet
set ws = Sheets("Sheet1")
Set rngSum = ws.Range("Q2:Q" & ws.Range("Q2").End(xlDown).Row)
Set rngCrit1 = rngSum.EntireRow.Columns("D")
Set rngCrit2 = rngSum.EntireRow.Columns("B")
Set wsSumm = Sheets("Summary")
With wsSumm.Range("B5").End(xlToRight).EntireColumn
Set ColRng = wsSumm.Range(.Cells(6), .Cells(149))
End With
For x = ColRng.Cells.Count To 1 Step -1
With ColRng.Cells(x)
' If the cell is empty, perform a SUMIFS
If IsEmpty(.Value) Then
.Formula = Application.SumIfs(rngSum, _
rngCrit1, .EntireRow.columns("E").Value, _
rngCrit2, .EntireRow.columns("B").Value)
End If
End With
Next x
I have a worksheet with sales data, I've managed to create Autofilter based on department and copied the results into the new sheet (Output). What I'm trying to achieve is that code will multiply the results of respective month by value in "Adjustment" row.
So the result is following
Is there a way how to process calculations within my code or I shall multiply each column in different Sub afterwards?
Dim Last_Row As Long
Dim DbExtract, DuplicateRecords As Worksheet
Dim WKS2 As Worksheet
Dim rn As Range
Set DbExtract = ThisWorkbook.Sheets("Data")
Set DuplicateRecords = ThisWorkbook.Sheets("Output")
Set WKS2 = ThisWorkbook.Sheets("Dashboard")
iMultiplier = WKS2.Range("Z18")
Application.ScreenUpdating = False
Last_Row = DuplicateRecords.Range("A" & Rows.Count).End(xlUp).Row + 1
DbExtract.Range("C3:R1500").SpecialCells(xlCellTypeVisible).Copy
DuplicateRecords.Range("A" & Last_Row).PasteSpecial
DuplicateRecords.Range("$A$1:$P$400").AutoFilter Field:=3, Criteria1:=WKS2.Range("V2")
Set rn = DuplicateRecords.Range("G2:G500").SpecialCells(xlCellTypeVisible)
For Each cell In rn
iNewnumber = cell * iMultiplier
Next cell
End Sub
Here's an example:
Sub Tester()
Dim lastRow As Long, wb As Workbook
Dim wsData As Worksheet, wsOutput As Worksheet
Dim wsDash As Worksheet, rngVis As Range, numVisRows As Long
Dim rn As Range, rngAdj As Range, m As Long, adj, c As Range
Set wb = ThisWorkbook
Set wsData = wb.Sheets("Data") 'consistent naming helps...
Set wsOutput = wb.Sheets("Output")
Set wsDash = wb.Sheets("Dashboard")
'iMultiplier = wsDash.Range("Z18") '?
Application.ScreenUpdating = False
Set rngVis = wsData.Range("C3:R1500").SpecialCells(xlCellTypeVisible)
numVisRows = rngVis.Cells.Count / rngVis.Columns.Count
rngVis.Copy
lastRow = wsOutput.Range("A" & Rows.Count).End(xlUp).Row + 1 'start of pasted data
wsOutput.Range("A" & lastRow).PasteSpecial
Set rngAdj = wsDash.Range("C5:N5") 'for example
For m = 1 To rngAdj.Columns.Count 'loop the cells in the adjustments range
adj = rngAdj.Cells(m).Value 'adjustment value
If Len(adj) > 0 And IsNumeric(adj) Then 'have an adjustment to make?
'loop the relevant cells in the pasted data
For Each c In wsOutput.Cells(lastRow, "A").Offset(0, 2 + m).Resize(numVisRows).Cells
If Len(c.Value) > 0 And IsNumeric(c.Value) Then 'any thing to adjust?
c.Value = c.Value * adj
End If
Next c
End If
Next m
End Sub
Can you help me correct my VBA codes. I want to convert the values of Column U until the active row to Absolute Values meaning to remove the negative amounts.
Here is my VBA code:
Sub MakeColumnsAbsoluteValue()
Dim sht As Worksheet
Dim rngToAbs As Range
Dim LastRow As Long
Dim c As Range
Set sht = ThisWorkbook.Sheets("MJEBlackline")
LastRow = sht.Cells(sht.Rows, Count, "U").End(xlUp).Row
Set rngToAbs = Range("U5:U" & LastRow)
For Each c In rngToAbs
c.Value = Abs(c.Value)
Next c
End Sub
Problem with line LastRow = sht.Cells(sht.Rows, Count, "U").End(xlUp).Row
Use of , instead of . and not specifying the sheet reference in rngToAbs
Try:
Sub MakeColumnsAbsoluteValue()
Dim sht As Worksheet
Dim rngToAbs As Range
Dim LastRow As Long
Dim c As Range
Set sht = ThisWorkbook.Sheets("FF")
LastRow = sht.Cells(sht.Rows.count, "U").End(xlUp).row
Set rngToAbs = sht.Range("U5:U" & LastRow)
For Each c In rngToAbs
c.Value = Abs(c.Value)
Next c
End Sub
You may try:
Sub MakeColumnsAbsoluteValue()
Dim sht As Worksheet
Dim rngToAbs As Range
Dim LastRow As Long
Set sht = ThisWorkbook.Sheets("MJEBlackline")
With sht
LastRow = .Cells(.Rows.Count, "U").End(xlUp).Row
Set rngToAbs = .Range("U5:U" & LastRow)
rngToAbs.Value = .Evaluate("=abs(" & rngToAbs.Address & ")")
End With
End Sub
Or even (inspired through #GarysStudent):
Sub MakeColumnsAbsoluteValue()
Dim sht As Worksheet
Dim rngToAbs As Range
Dim LastRow As Long
Set sht = ThisWorkbook.Sheets("MJEBlackline")
With sht
LastRow = .Cells(.Rows.Count, "U").End(xlUp).Row
Set rngToAbs = .Range("U5:U" & LastRow)
rngToAbs.Replace what:="-", lookat:=xlPart, replacement:=""
End With
End Sub
This would both convert the whole range in one go. Assuming that's what you meant with:
"I want to convert the values of Column U until the active row..."
You could try:
Option Explicit
Sub MakeColumnsAbsoluteValue()
Dim sht As Worksheet
Dim rngToAbs As Range, c As Range
Dim LastRow As Long, x As Long
Dim arr() As Variant
Set sht = ThisWorkbook.Sheets("MJEBlackline")
x = 0
With sht
LastRow = .Cells(.Rows.Count, "U").End(xlUp).Row
Set rngToAbs = .Range("U5:U" & LastRow)
'Loop range and create an array including all abs values
For Each c In rngToAbs
ReDim Preserve arr(x)
arr(x) = Abs(c.Value)
x = x + 1
Next c
'Paste the values of the array at once instead of pasting values one by one
.Range("U5:U" & LastRow).Value = Application.WorksheetFunction.Transpose(arr)
End With
End Sub
Despite reading several threads searching for answers to similar problems I have been unable to debug my code on its own.
I am trying to write a macro that will search all cells between AE and BF for the term "Aeronautics Engineers" and then copy all rows that contain that term to a new sheet. The entire sheet has a total of 99289.
I have tried using the following code without any luck:
Sub MoveAero()
Dim strArray As Variant
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim NoRows As Long
Dim DestNoRows As Long
Dim I As Long
Dim J As Integer
Dim rngCells As Range
Dim rngFind As Range
Dim Found As Boolean
strArray = Array("Aeronautic")
Set wsSource = ActiveSheet
NoRows = wsSource.Range("A65536").End(xlUp).Row
DestNoRows = 1
Set wsDest = ActiveWorkbook.Worksheets.Add
For I = 1 To NoRows
Set rngCells = wsSource.Range("AE" & I & ":BF" & I)
Found = False
For J = 0 To UBound(strArray)
Found = Found Or Not (rngCells.Find(strArray(J)) Is Nothing)
Next J
If Found Then
rngCells.EntireRow.Copy wsDest.Range("A" & DestNoRows)
DestNoRows = DestNoRows + 1
End If
Next I
End Sub
Thanks for any assistance!
Your problem is in your j loop:
For J = 0 To UBound(strArray)
The UpperBound (Ubound) of array strArray is 0. It's an array with a single element "Aeronautic".
So your loop is looping once and exiting.
Instead try looping through your range:
For Each rngCell in rngCells.Cells
if rngCell.value = "Aeronatic" Then
Found = True
Exit For
End if
Next rngCell
Here we loop through that rngCells range that you just made, cell by cell. Then we test if if the cell has the value you are looking for. If we find it, we set found to true and exit the for loop. You don't have to exit the for loop, but we found what we wanted, so there is no reason not to save some cpu time.
Full code, removed unnecessary variables and moved a little bit around:
Sub MoveAero()
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim NoRows As Long
Dim DestNoRows As Long
Dim I As Long
Dim J As Integer
Dim rngCells As Range
Dim rngCell as Range
Set wsSource = ActiveSheet
NoRows = wsSource.Range("A65536").End(xlUp).Row
DestNoRows = 1
Set wsDest = ActiveWorkbook.Worksheets.Add
For I = 1 To NoRows
Set rngCells = wsSource.Range("AE" & I & ":BF" & I)
For Each rngCell in rngCells.Cells
if rngCell.value = "Aeronatic" Then
'Moved this logic up from the IF block below
rngCells.EntireRow.Copy wsDest.Range("A" & DestNoRows)
DestNoRows = DestNoRows + 1
Exit For
End if
Next rngCell
Next I
End Sub
Alternatively, you could use that .find method of the range object instead of the second For loop. (Using both for your needs is unnecessary).
Sub MoveAero()
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim NoRows As Long
Dim DestNoRows As Long
Dim I As Long
Dim rngCells As Range
Set wsSource = ActiveSheet
NoRows = wsSource.Range("A65536").End(xlUp).Row
DestNoRows = 1
Set wsDest = ActiveWorkbook.Worksheets.Add
For I = 1 To NoRows
Set rngCells = wsSource.Range("AE" & I & ":BF" & I)
'Try to find your search term in the range
If Not (rngCells.Find("Aeronautic") Is Nothing) Then
rngCells.EntireRow.Copy wsDest.Range("A" & DestNoRows)
DestNoRows = DestNoRows + 1
End If
Next I
End Sub
I am trying to populate a range of cells dynamically using VLookup. My Active Sheet is where I am trying to insert value of cells from another worksheet in same workbook. For the second parameter of VLookup I am trying to use the variable dataRng which gets me the entire range of values to lookup in my source sheet (srcSheet). All the code works as expected except the VLookup returns #NAME? and its the dataRng variable which seems to be the issue. Any suggestions?
Sub VlookUpCreateDate()
Dim srcSheetName As String
Dim currSheetName As String
Dim currlastRow As Long
Dim currlastCol As Long
Dim srcLastRow As Long
Dim srcLastCol As Long
Dim srcFirstRow As Long
Dim srcSheet As Worksheet
Dim firstVar As String
Dim refRng As Range, ref As Range, dataRng As Range
srcSheetName = ActiveWorkbook.Worksheets(1).Name
Set srcSheet = ActiveWorkbook.Sheets(srcSheetName)
'Get Last Row and Column
With ActiveSheet
currlastRow = ActiveSheet.UsedRange.Rows.Count
currlastCol = ActiveSheet.UsedRange.Columns.Count
End With
With srcSheet
srcFirstRow = 2
srcLastRow = srcSheet.UsedRange.Rows.Count
srcLastCol = srcSheet.UsedRange.Columns.Count
End With
Set dataRng = srcSheet.Range(srcSheet.Cells(srcFirstRow, srcLastCol), srcSheet.Cells(srcLastRow, srcLastCol))
For i = 2 To currlastRow
Cells(i, currlastCol + 1).Select
ConvertToLetter & "$" & srcLastRow
ActiveCell.Formula = "=VLOOKUP(A2,dataRng,4,False)"
Next i
End Sub
Here is a simple example that should work for you, using the dataRng address in the formula
Dim dataRng As Range, s
Set dataRng = Range("AA1:AF7")
s = dataRng.Address
ActiveCell = "=VLOOKUP(A2," & s & ",4,0)"