I have to hide columns when a range is empty, and I have 2 ranges in different sheets to control when to hide or unhide these columns.
I'm trying to use a FOR loop with 2 variables, but i's not working, this is my code:
Sub HiddenColumns()
Dim HiddenColumn1 As Range
Dim HiddenColumn2 As Range
Dim c As Range
Dim d As Range
Set HiddenColumn1 = Range("rngColumnHidden")
Set HiddenColumn2 = Range("rngColumnHidden2")
For Each c In HiddenColumn1
For Each d In HiddenColumn2
If c.Value = "" Then
c.EntireColumn.Hidden = True
If d.Value = "" Then
d.EntireColumn.Hidden = True
End If
End If
Next d
Next c
End Sub
With one range it's working perfectly, but when I try to hide another range, I have problems, this is the code for one range:
Sub HiddenColumns()
Dim HiddenColumn1 As Range
Dim c As Range
Set HiddenColumn1 = Range("rngColumnHidden")
For Each c In HiddenColumn1
If c.Value = "" Then
c.EntireColumn.Hidden = True
End If
Next c
End Sub
edited after OP's comment
don't nest loops
Sub HiddenColumns()
Dim c As Range
For Each c In Range("rngColumnHidden").Rows(1).Cells
c.EntireColumn.Hidden = (c.Value = "")
Next c
For Each c In Range("rngColumnHidden2").Rows(1).Cells
c.EntireColumn.Hidden = (c.Value = "")
Next c
End Sub
and for the sake of avoiding code repetitions you could use a helper sub and code
Sub HiddenColumns()
HideColumns Range("rngColumnHidden")
HideColumns Range("rngColumnHidden2")
End Sub
Sub HideColumns(columnsRng As Range)
Dim c As Range
For Each c In columnsRng.Rows(1).Cells
c.EntireColumn.Hidden = (c.Value = "")
Next c
End Sub
Related
could someone please help me with this pretty simple problem I am having. Basically this is a simplified code for more a more complex problem I am trying to solve. I want to be able to output the values I have assigned to a,b,c,d and e in the column b. The values I have used for a,b,c,d and e are taken from cells a1,a2,a3,a4 and a5.
Thanks :)
Sub help()
Dim letters As String
Dim count As Integer
a = Range("a1").Value
b = Range("a2").Value
c = Range("a3").Value
d = Range("a2").Value
e = Range("a3").Value
letters = "abcde"
For count = 1 To Len(letters)
Range("b" & count) = Mid(letters, count, 1)
Next
'HOW DO I OUTPUT THE ASSIGNED VALUES TO a,b,c,d & e RATHER THAN OUTPUTTING LETTERS?'
End Sub
The easiest way is to change your code as follows:
Sub help()
a = Range("a1").Value
b = Range("a2").Value
c = Range("a3").Value
d = Range("a2").Value
e = Range("a3").Value
Range("b1").Value = a
Range("b2").Value = b
Range("b3").Value = c
Range("b4").Value = d
Range("b5").Value = e
End Sub
Alternatively, you could use an array instead of individual variables, e.g.
Sub help()
Dim myArr(1 To 5) As Variant
Dim count As Long
For count = 1 To 5
myArr(count) = Cells(count, "A").Value
Next count
For count = 1 To 5
Cells(count, "B").Value = myArr(count)
Next count
End Sub
That could also be simplified by saying:
Sub help()
Dim myArr As Variant
myArr = Range("A1:A5").Value ' myArr will be a two-dimensional array
Range("B1:B5").Value = myArr
End Sub
Or, as John Coleman suggested in a comment, you could use a Dictionary:
Sub help()
Dim myVars As Object
Dim letters As String
Dim count As Long
Set myVars = CreateObject("Scripting.Dictionary")
myVars("a") = Range("a1").Value
myVars("b") = Range("a2").Value
myVars("c") = Range("a3").Value
myVars("d") = Range("a2").Value
myVars("e") = Range("a3").Value
letters = "abcde"
For count = 1 To Len(letters)
Range("b" & count) = myVars(Mid(letters, count, 1))
Next
End Sub
Simply turn around the assignment you made to the variable and make it go to the cell.
A couple other quick tips:
Also, while VBA doesn't require specific variable declarations, the implicit declared type is always Variant. So it's considered professional practice to declare all variables and always use Option Explicit.
Always define and set references to the workbook and worksheets.
So...
Sub help()
Dim wb as Workbook
Dim ws as Worksheet
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")
Dim a as String
a = ws.Range("A1")
ws.Range("B1") = a
End Sub
i'm writing a code and i'm stuck on this problem which i think should not bee too difficult to solve but i don't manage it.
I need my program to find all cells with a particular value and select them. But they should remain selected at the end of the sub.
So i changed a bit a code i found on the web and wrote that:
Sub FindAll()
With Worksheets(4).Range("a1:l500")
Set c = .Find("myValue", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Worksheets(4).Range(c.Address).Activate
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Sub
Of course it selects them in sequence but they do not remain selected, so at the end i just have the last found cell selected
Can anyone help me solve that?
Thanks in advance
Use the Union method to collect the ranges into one discontiguous range then .Select them before leaving the sub
Sub FindAll()
Dim firstAddress As String, c As Range, rALL As Range
With Worksheets(4).Range("a1:l500")
Set c = .Find("myValue", LookIn:=xlValues)
If Not c Is Nothing Then
Set rALL = c
firstAddress = c.Address
Do
Set rALL = Union(rALL, c)
Worksheets(4).Range(c.Address).Activate
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
.Activate
If Not rALL Is Nothing Then rALL.Select
End With
End Sub
As #Jeeped has already answered, using the Union Method will achieve what you were after.
If the range you were searching for values within was to increase, it would be more efficient to use an Array to hold the values; you can then search the array instead of the worksheet.
Just something to think about for the future.
Option Explicit
Sub arrayFindAll()
Dim wb As Workbook, ws As Worksheet
Dim myArr() As Variant, myCells() As Integer
Dim i As Long, j As Integer, k As Integer, m As Integer
Dim valOccurence As Integer
Dim unionCells As Range, lookupRng As Range
Set wb = ThisWorkbook
Set ws = wb.Sheets(4)
Set lookupRng = ws.Range("A1:L500")
myArr = lookupRng
valOccurence = WorksheetFunction.CountIf(lookupRng, "myValue") - 1
ReDim myCells(0 To valOccurence, 0 To 1)
For i = LBound(myArr, 1) To UBound(myArr, 1)
For j = LBound(myArr, 2) To UBound(myArr, 2)
If myArr(i, j) = "myValue" Then
For k = 0 To UBound(myCells, 1)
If myCells(k, 0) = 0 Then
myCells(k, 0) = i
myCells(k, 1) = j
Exit For
End If
Next k
End If
Next j
Next i
Set unionCells = Cells(myCells(m, 0), myCells(m, 1))
For m = 1 To valOccurence
Set unionCells = Union(unionCells, Cells(myCells(m, 0), myCells(m, 1)))
Next m
unionCells.Select
End Sub
Is there a faster, or more practical way of hiding rows in all sheets that have a zero value in column A? I have set up multiple macros to hide the rows, but this takes about 50-70 secs to complete any faster way?
Sub Macro14()
Dim c As Range
For Each c In Sheets("Main").Range("A200:A500")
If c.value = 0 Then
Sheets("Main").Rows(c.Row).Hidden = True
Else
Sheets("Main").Rows(c.Row).Hidden = False
End If
Next
End Sub
Sub Macro15()
Dim c As Range
For Each c In Sheets("Elkhart East").Range("A50:A300")
If c.value = 0 Then
Sheets("Elkhart East").Rows(c.Row).Hidden = True
Else
Sheets("Elkhart East").Rows(c.Row).Hidden = False
End If
Next
End Sub
Sub Macro16()
Dim c As Range
For Each c In Sheets("Tennessee").Range("A50:A300")
If c.value = 0 Then
Sheets("Tennessee").Rows(c.Row).Hidden = True
Else
Sheets("Tennessee").Rows(c.Row).Hidden = False
End If
Next
End Sub
Sub Macro17()
Dim c As Range
For Each c In Sheets("Alabama").Range("A50:A300")
If c.value = 0 Then
Sheets("Alabama").Rows(c.Row).Hidden = True
Else
Sheets("Alabama").Rows(c.Row).Hidden = False
End If
Next
End Sub
Sub Macro18()
Dim c As Range
For Each c In Sheets("North Carolina").Range("A50:A300")
If c.value = 0 Then
Sheets("North Carolina").Rows(c.Row).Hidden = True
Else
Sheets("North Carolina").Rows(c.Row).Hidden = False
End If
Next
End Sub
Sub Macro19()
Dim c As Range
For Each c In Sheets("Pennsylvania").Range("A50:A300")
If c.value = 0 Then
Sheets("Pennsylvania").Rows(c.Row).Hidden = True
Else
Sheets("Pennsylvania").Rows(c.Row).Hidden = False
End If
Next
End Sub
Sub Macro20()
Dim c As Range
For Each c In Sheets("Texas").Range("A50:A300")
If c.value = 0 Then
Sheets("Texas").Rows(c.Row).Hidden = True
Else
Sheets("Texas").Rows(c.Row).Hidden = False
End If
Next
End Sub
Sub Macro21()
Dim c As Range
For Each c In Sheets("West Coast").Range("A50:A300")
If c.value = 0 Then
Sheets("West Coast").Rows(c.Row).Hidden = True
Else
Sheets("West Coast").Rows(c.Row).Hidden = False
End If
Next
End Sub
This should do it in a pretty fast way:
Sub test()
Dim x As Variant, i As Long, j(1) As Long, rngVal As Variant, rnghide As Range, rngshow As Range, sht As Object
For Each sht In ActiveWorkbook.Sheets(Array("Main", "Elkhart East", "Tennessee", "Alabama", "North Carolina", "Pennsylvania", "Texas", "West Coast"))
Set rnghide = Nothing
Set rngshow = Nothing
If sht.Name = "Main" Then
j(0) = 200
j(1) = 500
Else
j(0) = 50
j(1) = 300
End If
x = sht.Range("A1:A" & j(1)).Value
For i = j(0) To j(1)
If x(i, 1) = 0 Then
If rnghide Is Nothing Then Set rnghide = sht.Rows(i) Else Set rnghide = Union(rnghide, sht.Rows(i))
Else
If rngshow Is Nothing Then Set rngshow = sht.Rows(i) Else Set rngshow = Union(rngshow, sht.Rows(i))
End If
Next
rnghide.EntireRow.Hidden = True
rngshow.EntireRow.Hidden = False
Next
End Sub
It simply runs each sheet for the whole range and stores the rows to show/hide in seperate ranges and then change there status in one step (1 for show and 1 for hide for each sheet)
If you have any questions or get any errors just tell me (can't test it right now)
Use an array:
Sub t()
Dim sheetArray() As Variant
Dim ws&, finalRow&, startRow&
Dim c As Range
sheetArray = Array("Alabama", "North Carolina", "West Coast")
For ws = LBound(sheetArray) To UBound(sheetArray)
If sheetArray(ws) = "Main" Then
startRow = 200
finalRow = 500
Else
startRow = 50
finalRow = 300
End If
For Each c In Sheets(sheetArray(ws)).Range("A" & startRow & ":A" & finalRow)
If c.Value = 0 And Not IsEmpty(c) Then
Sheets(sheetArray(ws)).Rows(c.Row).Hidden = True
Else
Sheets(sheetArray(ws)).Rows(c.Row).Hidden = False
End If
Next c
Next ws
End Sub
Just add to that array and it should work a little faster for you. If you have a ton of sheets, and don't want to manually type them into the VBA code, you can always set the array to the range of sheet names, then just go from there. Let me know if you need help doing so.
This also assumes you don't want to just loop through the workbook. If so, you can just do For each ws in ActiveWorkbook instead of lBound()...
Edit: I added some code to check the sheet, so it'll correctly adjust your ranges.
use this :
For Each ws In ActiveWorkbook.Worksheets
For Each c In ws.Range(IIf(ws.Name = "Main", "A200:A500", "A50:A300"))
ws.Rows(c.Row).Hidden = c.Value = 0
Next
Next
if you want exclude sheet Raw,Main and Calendar :
Dim untreatedSheet As Variant
untreatedSheet = Array("Raw", "Main", "Calendar")
For Each ws In ActiveWorkbook.Worksheets
If Not (UBound(Filter(untreatedSheet, ws.Name)) > -1) Then
For Each c In ws.Range("A50:A300")
ws.Rows(c.Row).Hidden = c.Value = 0
Next
End If
Next
This will work if you select all the sheets you want filtered FIRST:
Sub HideRows()
Dim ws As Worksheet
sAddress = "A:A"
For Each ws In ActiveWindow.SelectedSheets
ws.Range(sAddress).AutoFilter Field:=1, Criteria1:="<>0"
Next ws
End Sub
i'm writing a code and i'm stuck on this problem which i think should not bee too difficult to solve but i don't manage it.
I need my program to find all cells with a particular value and select them. But they should remain selected at the end of the sub.
So i changed a bit a code i found on the web and wrote that:
Sub FindAll()
With Worksheets(4).Range("a1:l500")
Set c = .Find("myValue", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Worksheets(4).Range(c.Address).Activate
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Sub
Of course it selects them in sequence but they do not remain selected, so at the end i just have the last found cell selected
Can anyone help me solve that?
Thanks in advance
Use the Union method to collect the ranges into one discontiguous range then .Select them before leaving the sub
Sub FindAll()
Dim firstAddress As String, c As Range, rALL As Range
With Worksheets(4).Range("a1:l500")
Set c = .Find("myValue", LookIn:=xlValues)
If Not c Is Nothing Then
Set rALL = c
firstAddress = c.Address
Do
Set rALL = Union(rALL, c)
Worksheets(4).Range(c.Address).Activate
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
.Activate
If Not rALL Is Nothing Then rALL.Select
End With
End Sub
As #Jeeped has already answered, using the Union Method will achieve what you were after.
If the range you were searching for values within was to increase, it would be more efficient to use an Array to hold the values; you can then search the array instead of the worksheet.
Just something to think about for the future.
Option Explicit
Sub arrayFindAll()
Dim wb As Workbook, ws As Worksheet
Dim myArr() As Variant, myCells() As Integer
Dim i As Long, j As Integer, k As Integer, m As Integer
Dim valOccurence As Integer
Dim unionCells As Range, lookupRng As Range
Set wb = ThisWorkbook
Set ws = wb.Sheets(4)
Set lookupRng = ws.Range("A1:L500")
myArr = lookupRng
valOccurence = WorksheetFunction.CountIf(lookupRng, "myValue") - 1
ReDim myCells(0 To valOccurence, 0 To 1)
For i = LBound(myArr, 1) To UBound(myArr, 1)
For j = LBound(myArr, 2) To UBound(myArr, 2)
If myArr(i, j) = "myValue" Then
For k = 0 To UBound(myCells, 1)
If myCells(k, 0) = 0 Then
myCells(k, 0) = i
myCells(k, 1) = j
Exit For
End If
Next k
End If
Next j
Next i
Set unionCells = Cells(myCells(m, 0), myCells(m, 1))
For m = 1 To valOccurence
Set unionCells = Union(unionCells, Cells(myCells(m, 0), myCells(m, 1)))
Next m
unionCells.Select
End Sub
I want to create a macro for the following:
For each row, if there are cell values in range C3:ACP3 that are >= value of ACU3, I want to replace that cell value with blank. I want to do this for every row, and each time the macro should reference the value in the ACU column for that row.
Try this:
Sub makeBlank()
Dim r As Range
Set r = Excel.ThisWorkbook.Sheets("Sheet1").Range("C3:ACP3")
Dim v As Double
v = Excel.ThisWorkbook.Sheets("Sheet1").Range("ACU3").Value
Dim c
For Each c In r
If c.Value >= v Then
c.Value = ""
End If
Next c
End Sub
EDIT
I suspect this will be quicker using arrays:
Sub makeBlank2()
Dim v
v = Excel.ThisWorkbook.Sheets("Sheet1").Range("ACU3").Value
Dim Arr() As Variant
Arr = Sheet1.Range("C3:ACP3")
Dim R, C As Long
For R = 1 To UBound(Arr, 1)
For C = 1 To UBound(Arr, 2)
If Arr(R, C) > v Then
Arr(R, C) = ""
End If
Next C
Next R
Sheet1.Range("C3:ACP3") = Arr
End Sub
Try this:
Sub FindDelete()
Dim ACU_Val As Double
Dim cl As Range
Dim rw As Long
For rw = 1 To Rows.Count
If Range("ACU" & rw).Value = "" Then Exit For
ACU_Val = Range("ACU" & rw).Value
For Each cl In Range("C" & rw & ":ACP" & rw)
If cl.Value >= ACU_Val Then cl.Value = ""
Next cl
Next
End Sub
you need to iterate over your desired range of cells and for each cell which contents are above the threshold value in the ACU column of the same row just clear its contents.
For Each c In Range("C3:ACP3")
If c.Value >= Cells(c.Row, "ACU") Then
c.clearContents
End If
Next c
Simple :
Dim myCell As Range
numberOfRows = 1000
For i = 0 To numberOfRows
Dim myRow As Range
Set myRow = [C3:ACP3].Offset(i, 0)
bound = Intersect([acu3].EntireColumn, myRow.EntireRow)
For Each myCell In myRow
If myCell >= bound Then myCell = ""
Next
Next