I want to update the filtered values of a column using vba macros. Eg. Flag column has values Y and N and I have filtered to N. Now I want to update the value "N" to some other value. Below is a sample image. Can someone please suggest ?
Give this a try:
Sub Framm()
Dim rng As Range, cell As Range
Set rng = ActiveSheet.AutoFilter.Range
Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1, 1)
For Each cell In rng.Columns(1).Cells.SpecialCells(xlCellTypeVisible)
cell.Value = "changed"
Next cell
End Sub
Here is my code:
Sub SubChangeAutofilteredValues()
'Declarations.
Dim RngRange01 As Range
Dim StrOldValue As String
Dim StrNewValue As String
'Setting variables.
StrOldValue = "N"
StrNewValue = "K"
'Autofiltering.
ActiveSheet.AutoFilter.Range.AutoFilter Field:=1, Criteria1:=StrOldValue
'Verifying if any match has been found.
If Cells(ActiveSheet.AutoFilter.Range.Rows.Count + 1, 1).End(xlUp).Row = 1 Then
MsgBox "No records found.", , "No records found"
Exit Sub
End If
'Setting the variable.
With ActiveSheet.AutoFilter.Range
Set RngRange01 = .Resize(.Rows.Count - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible)
End With
'Changing the values.
RngRange01.Value = StrNewValue
End Sub
Related
I am trying to add a line of code in VBA that will ask if the range has a value of HP-1 to then to make it 16 GA. else, it needs to be 26 GA.
Currently code just converts everything to 26 GA.
Sheets("TRIM").Select
Range("D13").Select
Do Until ActiveCell.Offset(0, -1).Value = ""
If ActiveCell.Value <> "" Then
ActiveCell.Value = "26 GA."
End If
ActiveCell.Offset(1, 0).Select
Loop EndIf
So I need to add in something that will do the HP-1 condition...I did try to make an Else statement but getting NO compile errors but getting this one.
this error has nothing to do with 32bit/64 bit as we are all still using 32bit Excel with 32bit VBA codeI'm sure it is pretty easy but can't seem to get the syntax down...
Any suggestions?
This is the original function in total...
Nest your If Statements:
Note: depending on your data layout, you may need to find a different way of defining RG, however, this should work.
Option Explicit
Sub Example()
Dim WS As Worksheet
Dim RG As Range
Dim CL As Range
Set WS = Worksheets("TRIM")
' Build Range "RG" from D13 to last used cell in D column
With WS
Set RG = .Range("D13", .Range("D" & Rows.Count).End(xlUp))
End With
' For each cell in the range "RG"
For Each CL In RG.Cells
If CL.Value <> "" Then 'Check if the value of the cell is ""
If CL.Value = "HP-1" Then 'Check if the value of the cell is "HP-1"
CL.Value = "16 GA" 'Change Value of the cell
Else
CL.Value = "26 GA" 'Change Value of the cell
End If
End If
Next CL
End Sub
Populate Cells Conditionally
Replace your code with the following.
Dim ws As Worksheet: Set ws = Sheets("TRIM")
If ws.Visible = xlSheetVisible Then
Dim cell As Range: Set cell = ws.Cells(ws.Rows.Count, "C").End(xlUp)
Dim rg As Range, rCount As Long
With ws.Range("D13")
rCount = cell.Row - .Row + 1
If rCount > 0 Then Set rg = .Resize(rCount)
End With
If Not rg Is Nothing Then ' data found
For Each cell In rg.Cells
If StrComp(CStr(cell.Value), "HP-1", vbTextCompare) = 0 Then
cell.Value = "16 GA."
Else ' is not 'HP-1'
cell.Value = "26 GA."
End If
Next cell
'Else ' no data found; do nothing!?
End If
'Else ' worksheet not visible; do nothing!?
End If
I have the following code to find the first blank cell and sum the data below it at the last blank cell.
Dim r As Range
Dim lngRowStart As Long
If Range("A1").Formula <> "" Then
lngRowStart = 1
Else
lngRowStart = Range("A1").End(xlDown).Row
End If
Set r = Cells(lngRowStart, 1).End(xlDown).Offset(1, 0)
If Left(r.Offset(-1, 0).Formula, 1) <> "=" Then
r.FormulaR1C1 = "=Subtotal(9,R[-" & r.Row - lngRowStart & "]C:R[-1]C)"
End If
But this assumes that the data is in column A and for the first set of continuous data, how to modify it for any active cell to sum the above continuous data?
For example:
2
4
3
Blank (SUM ABOVE=9)
1
3
2
Blank (SUM ABOVE=6)
You can use the UDF below (explanation inside the code's comments):
Function SumContinRange(CurCell As Range) As Double
Dim RngStart As Range, SumRng As Range
If CurCell <> "" Then
' find the first empty cell using the Find function
Set RngStart = Columns(CurCell.Column).Find(what:="", After:=CurCell, LookIn:=xlValues)
Else
' find the first empty cell using the Find function
Set RngStart = Columns(CurCell.Column).Find(what:="", After:=CurCell, LookIn:=xlValues, SearchDirection:=xlPrevious)
End If
' set the Sum Range
Set SumRng = Range(RngStart.Offset(-1, 0), RngStart.Offset(-1, 0).End(xlUp))
SumContinRange = WorksheetFunction.Sum(SumRng) ' return this value
End Function
Then, test it by passing the ActiveCell using the Sub below:
Sub TestFunc()
If ActiveCell.Value <> "" Then
ActiveCell.End(xlDown).Offset(1) = SumContinRange(ActiveCell)
Else
ActiveCell = SumContinRange(ActiveCell)
End If
End Sub
I have a spreadsheet that is updated regularly. Therefore the column header positions change regularly. eg. today "Username" is column K, but tomorrow "Username" might be column L. I need to add a new column to the right of "Username" but where it changes I cannot refer to as cell/column reference.
So far I have:
Dim rngUsernameHeader As Range
Dim rngHeaders As Range
Set rngHeaders = Range("1:1") 'Looks in entire first row.
Set rngUsernameHeader = rngHeaders.Find("Username")
When I go to add a new column to the right of it, I'm selecting that row but it's going back to cell/column references...
Columns("K:K").Select
Selection.Insert Shift:=xlToRight
Range("K1").Select
ActiveCell.FormulaR1C1 = "Role"
How can I perform this step with a macro?
edit: I think need to give that Column a header name and begin populating the row with data - each time I do begins the cell references which I want to avoid wherever possible.
Many thanks in advance.
How about:
Sub qwerty()
Dim rngUsernameHeader As Range
Dim rngHeaders As Range
Set rngHeaders = Range("1:1") 'Looks in entire first row.
Set rngUsernameHeader = rngHeaders.Find(what:="Username", After:=Cells(1, 1))
rngUsernameHeader.Offset(0, 1).EntireColumn.Insert
rngUsernameHeader.Offset(0, 1).Value = "role"
End Sub
Sub AddColumn
Dim cl as Range
For each cl in Range("1:1")
If cl = "username" Then
cl.EntireColumn.Insert Shift:= xlToRight
End If
cl.Offset(0, 1) = "role"
Next cl
End Sub
Untested code as not at my desktop
Something like this should work. The idea is that you locate the column and then you insert to the right. That is why you have the +1 in the TestMe. The function l_locate_value_col returns the column, where it has found the value. If you want, you may change the optional parameter l_row, depending on which row do you want to look for.
Option Explicit
Public Sub TestMe()
Dim lngColumn As Long
lngColumn = l_locate_value_col("Username", ActiveSheet)
Cells(1, lngColumn + 1).EntireColumn.Insert
End Sub
Public Function l_locate_value_col(target As String, _
ByRef target_sheet As Worksheet, _
Optional l_row As Long = 1)
Dim cell_to_find As Range
Dim r_local_range As Range
Dim my_cell As Range
Set r_local_range = target_sheet.Range(target_sheet.Cells(l_row, 1), target_sheet.Cells(l_row, Columns.Count))
For Each my_cell In r_local_range
If target = Trim(my_cell) Then
l_locate_value_col = my_cell.Column
Exit Function
End If
Next my_cell
l_locate_value_col = -1
End Function
You could name your range:
Sub Test()
Dim rngUsernameHeader As Range
'UserName is in column F at the moment.
Set rngUsernameHeader = Range("UserName")
Debug.Print rngUsernameHeader.Address 'Returns $F$1
ThisWorkbook.Worksheets("Sheet2").Range("E:E").Insert Shift:=xlToRight
Debug.Print rngUsernameHeader.Address 'Returns $G$1
End Sub
Edit:
Have rewritten so it inserts a column after your named column and returns that reference:
Sub Test()
Dim rngUsernameHeader As Range
Dim rngMyNewColumn As Range
Set rngUsernameHeader = Range("UserName")
rngUsernameHeader.Offset(, 1).Insert Shift:=xlToRight
'You'll need to check the named range doesn't exist first.
ThisWorkbook.Names.Add Name:="MyNewRange", _
RefersTo:="='" & rngUsernameHeader.Parent.Name & "'!" & _
rngUsernameHeader.Offset(, 1).Address
Set rngMyNewColumn = Range("MyNewRange")
MsgBox rngMyNewColumn.Address
End Sub
I want to unhide a single row if an ENTIRE range of rows is hidden. I want to hide this row if even a SINGLE row within the range is unhidden. What is the syntax for this? My current code is as follows:
Public Sub MySub()
Application.ScreenUpdating = False
With Range("A1:A5")
.EntireRow.Hidden = False
For Each cell In Range("A1:A5")
Select Case cell.Value
Case Is = "-"
cell.EntireRow.Hidden = True
End Select
Next cell
End With
Application.ScreenUpdating = True
End Sub
I think I understand. How's this:
Sub test()
Dim cel As Range, rng As Range
Dim hideRow&, numDashes&
Set rng = Range("A1:A5")
hideRow = rng.Count + 1
For Each cel In rng
If cel.Value = "-" Then
numDashes = numDashes + 1
Rows(cel.Row).EntireRow.Hidden = True
End If
Next cel
If numDashes = rng.Count Then
' If all cells in the range are '-'
Rows(hideRow).EntireRow.Hidden = False
Else
Rows(hideRow).EntireRow.Hidden = True
End If
End Sub
I'm kind of assuming that you want to hide/unhide Row 6, since it's one below your range's last row. Therefore, I created a variable to hold this. This way, if you want to change your range to say A1:A100, all you have to do is adjust the rng, and it'll look to hide/unhide row 101. Of course, if you just need it to be 6, then just do hideRow = 6.
Edit: For fun, I tried to reduce the use of the counting variable numDashes and tried to the part where you check your range for all - to be more concise. The below should work too, but might need a tweak or two:
Sub test2()
Dim cel As Range, rng As Range
Dim hideRow&
Set rng = Range("A1:A5")
hideRow = rng.Count + 1
'Check to see if your range is entirely made up of `-`
If WorksheetFunction.CountIf(rng, "-") = rng.Count Then
Rows(hideRow).EntireRow.Hidden = False
' If you want to stop your macro if ALL range values are "-", then uncomment the next line:
'Exit Sub
Else
Rows(hideRow).EntireRow.Hidden = True
End If
For Each cel In rng
If cel.Value = "-" Then
Rows(cel.Row).EntireRow.Hidden = True
End If
Next cel
End Sub
You can do this with a formula in a helper column. I used this one for financial statements to suppress rows where multiple column are all zero to shorten up the report.
=IF(AND(SUM(A7:R7)<1,SUM(A7:R7)>-1),IF(OR(ISNUMBER(LEFT(H7,4)),ISBLANK(H7),ISERR(VALUE(LEFT(H7,4)))),"Show","Hide"),"Show").
Then filter the rows by that column.
I need to find out the first cell and the last cell of a vertically merged cell..
Let's say I merge Cells B2 down to B50.
How can I get in VBA the start cell(=B2) and the end cell(=B50)?
Sub MergedAreaStartAndEnd()
Dim rng As Range
Dim rngStart As Range
Dim rngEnd As Range
Set rng = Range("B2")
If rng.MergeCells Then
Set rng = rng.MergeArea
Set rngStart = rng.Cells(1, 1)
Set rngEnd = rng.Cells(rng.Rows.Count, rng.Columns.Count)
MsgBox "First Cell " & rngStart.Address & vbNewLine & "Last Cell " & rngEnd.Address
Else
MsgBox "Not merged area"
End If
End Sub
Below macro goes through all sheets in a workbook and finds merged cells, unmerge them and put original value to all merged cells.
This is frequently needed for DB applications, so I wanted to share with you.
Sub BirlesenHucreleriAyirDegerleriGeriYaz()
Dim Hucre As Range
Dim Aralik
Dim icerik
Dim mySheet As Worksheet
For Each mySheet In Worksheets
mySheet.Activate
MsgBox mySheet.Name & “ yapılacak…”
For Each Hucre In mySheet.UsedRange
If Hucre.MergeCells Then
Hucre.Orientation = xlHorizontal
Aralik = Hucre.MergeArea.Address
icerik = Hucre
Hucre.MergeCells = False
Range(Aralik) = icerik
End If
Next
MsgBox mySheet.Name & " Bitti!!"
Next mySheet
End Sub
Suppose you merged B2 down to B50.
Then, start cell address will be:
MsgBox Range("B2").MergeArea.Cells(1, 1).Address
End cell address will be:
With Range("B2").MergeArea
MsgBox .Cells(.Rows.Count, .Columns.Count).Address
End With
You can put address of any cell of merged area in place of B2 in above code.
Well, assuming you know the address of one of the cells in the merged range, you could just select the offset from that range and get the row/column:
Sub GetMergedRows()
Range("A7").Select 'this assumes you know at least one cell in a merged range.
ActiveCell.Offset(-1, 0).Select
iStartRow = ActiveCell.Row + 1
Range("A7").Select
ActiveCell.Offset(1, 0).Select
iEndRow = ActiveCell.Row - 1
MsgBox iStartRow & ":" & iEndRow
End Sub
The code above will throw errors if the offset row cannot be selected (i.e. if the merged rows are A1 through whatever) so you will want to add error handling that tells the code if it can't offset up, the top rows must be 1 and if it can't go down, the bottom row must be 65,536. This code is also just one dimensional so you might want to add the x-axis as well.
If you want the cell references as strings, you can use something like this, where Location, StartCell, and EndCell are string variables.
Location = Selection.Address(False, False)
Colon = InStr(Location, ":")
If Colon <> 0 Then
StartCell = Left(Location, Colon - 1)
EndCell = Mid(Location, Colon + 1)
End If
If you want to set them as ranges, you could add this, where StartRange and EndRange are Range objects.
set StartRange = Range(StartCell)
set EndRange = Range (EndCell)
If you intend to loop through the merged cells, try this.
Sub LoopThroughMergedArea()
Dim rng As Range, c As Range
Set rng = [F5]
For Each c In rng.MergeArea
'Your code goes here
Debug.Print c.Address'<-Sample code
Next c
End Sub