I am trying to replace the value in a cell so if it has 0 to hide it.
The excel formula is the following IF(A1=0;"";A1).
I am trying to this automaticaly but I am having problems.
So far I came up with this:
Sub apply_Error_Control()
Dim cel As Range
For Each cel In Selection
If cel.HasFormula Then
cel.Formula = Replace(cel.Formula, "=", "=IFF(") & "=0" & ";" & "")"
End If
Next cel
End Sub
Give this link a view:
Three ways to hide zero values
I'd still strongly recommend going down the cell formatting route:
Sub apply_Error_Control()
Dim rngCurrent As Range
If TypeName(Selection) = "Range" Then
Set rngCurrent = Selection.SpecialCells(xlCellTypeFormulas)
rngCurrent.NumberFormat = "0;-0;;#"
End If
End Sub
But if you insist on the formula-based approach, please at least employ the method I've outlined so that you avoid running the code on (for example) an embedded chart or button and you'll immediately hit those cells with a formula - looping through to find those with a formula is tedious and slow.
Give this a try (note the Selection.Cells so it'll only work in the Range that you selected manually) :
Sub apply_Error_Control()
Dim cel As Range, _
RangeInForumla As String
For Each cel In Selection.Cells
If cel.HasFormula Then
RangeInForumla = Replace(cel.Formula, "=", "",1,1)
cel.Formula = "=IF(" & RangeInForumla & "=0," & Chr(34) & Chr(34) & "," & RangeInForumla & ")"
End If
Next cel
End Sub
Related
Really inexperienced in VBA
I'm trying to built a macro searching differents strings in multiple columns.
I'm searching pattern like : "[ang]" "[fre]" "_[ger]
For now, I'm able to find _[ang] in column H, but I think there's a way to find all three patterns with one formula. Important part is to add a note in a specific cell (that's why I use cel.Offset(0, 4))
Sub testsearch()
For Each cel In ActiveSheet.Range("H1:H" & Range("H" & Rows.Count).End(xlUp).Row)
If cel Like "*_[ang]*" Then
cel.Offset(0, 4) = "_[ang]"
End If
Next cel
End Sub
What about this..
Sub testsearch()
Application.ScreenUpdating = False
Dim string_patterns As Variant
string_patterns = Array("_[ang]", "[fre]", "_[ger]")
For Each cel In ActiveSheet.Range("H1:H" & Range("H" & Rows.Count).End(xlUp).Row)
For Each element In string_patterns
If cel Like "*" & CStr(element) & "*" Then
cel.Offset(0, 4) = CStr(element)
Exit For
End If
Next element
Next cel
Application.ScreenUpdating = True
End Sub
I'm looking to use a marco that would be able to search a column in said sheet and if certain text is found - in my case the word "FAIL" - copy that entire rows data/formatting and paste it into another sheet - sheet 4 in my case - along with any other rows that contained that specific text.
i have been using this code but it only copy pastes one row then stops rather than going through and copying any rows with "FAIL"
Sub Test()
For Each Cell In Sheets(1).Range("H:H")
If Cell.Value = "FAIL" Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow).Select
Rows(matchRow & ":" & matchRow).Select
Selection.Copy
Sheets(4).Select
ActiveSheet.Rows(matchRow).Select
ActiveSheet.Paste
Sheets(4).Select
End If
Next
End Sub
First post and brand new to VBA so apologies if too vague.
Try the code below (explanation inside the code as comments):
Option Explicit
Sub Test()
Dim Cell As Range
With Sheets(1)
' loop column H untill last cell with value (not entire column)
For Each Cell In .Range("H1:H" & .Cells(.Rows.Count, "H").End(xlUp).Row)
If Cell.Value = "FAIL" Then
' Copy>>Paste in 1-line (no need to use Select)
.Rows(Cell.Row).Copy Destination:=Sheets(4).Rows(Cell.Row)
End If
Next Cell
End With
End Sub
Try like this:
Option Explicit
Sub TestMe()
Dim Cell As Range
Dim matchRow As Long
With Worksheets(1)
For Each Cell In .Range("H:H")
If Cell.Value = "FAIL" Then
matchRow = .Cell.Row
.Rows(matchRow & ":" & matchRow).Select
.Rows(matchRow & ":" & matchRow).Select
Selection.Copy
Worksheets(4).Select
Worksheets(4).Rows(matchRow).Select
Worksheets(4).Paste
.Select
End If
Next
End With
End Sub
The problem in your code is that you do not reference the worksheets all the time correctly. Thus it does not work correctly.
As a 2. step, you can try to avoid all the selections in your code, it is a best practice to avoid using either Select or Activate in Excel VBA.
I've designed a search box that filters my table when text is entered into said search box. The problem is that it is soooo slow, it's almost not even worth having it in my workbook right now.
Can anyone think of any way to revise/improve upon this code?
Here is my code currently:
Private Sub TextBox1_Change()
Dim searchArea As Range, searchRow As Range, searchCell As Range
Dim searchString As String
Dim lastRow As Integer
Application.ScreenUpdating = False
searchString = "*" & LCase(TextBox1.Value) & "*"
Rows.Hidden = False
lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Set searchArea = Me.Range("f3:f791", "f3" & lastRow)
searchArea.EntireRow.Hidden = True
For Each searchRow In searchArea.Rows
For Each searchCell In searchRow.Cells
If LCase(searchCell) Like searchString Then
searchRow.Hidden = False
Exit For
End If
Next searchCell
Next searchRow
Application.Goto Range("Z1"), True
ActiveWindow.ScrollColumn = 1
Application.ScreenUpdating = True
End Sub
Edited my code to this:
Private Sub TextBox1_Change()
ActiveSheet.ListObjects("states").Range.AutoFilter Field:=1, _
Criteria1:="*" & [G1] & "*", Operator:=xlFilterValues
End Sub
However, this is not working. There are text and numbers in Field 1, and this only is filtering text, not the numbers...
This is definitely redundantly redundant, because your iteration is over a single column:
For Each searchRow In searchArea.Rows
For Each searchCell In searchRow.Cells '### searchRow ONLY HAS ONE CELL! This second/inner loop is totally unnecessary
If LCase(searchCell) Like searchString Then
searchRow.Hidden = False
Exit For
End If
Next searchCell
Next searchRow
Rewrite as:
For Each searchCell in searchArea.Cells '## Assumes searchArea is single column
searchCell.EntireRow.Hidden = Not (LCase(searchCell) Like searchString)
Next
That alone should improve performance, but I think AutoFilter is a better method, and you should be able to derive the basic code for that from the Macro Recorder.
This would look something like:
searchArea.AutoFilter Field:=1, Criteria1:="=" & searchString, _
Operator:=xlAnd, Criteria2:="<>"
This should filter to display only non-blank rows which contain your searchString
#Yowe3k's points about the range assigment should also be noted, and you may use the AfterUpdate event of the TextBox instead of the Change event.
UPDATE This might work to handle your mixed cases of numeric/text values. There might be a better way to do this but I don't see an obvious solution. The AutoFilter is meant to work with either text or numbers, but not both. So this attempts to convert numeric values to string representations. You may need to make changes elsewhere if the numeric values are referenced in formula, etc.
Dim arr, v
Dim tbl As ListObject
Set tbl = ActiveSheet.ListObjects(1)
' ## Disable filter if it's on already
If tbl.Range.AutoFilter Then tbl.Range.AutoFilter
arr = tbl.DataBodyRange.Columns(1).Value
' ## Convert your range of mixed numeric/string to string
For v = LBound(arr, 1) To UBound(arr, 1)
If IsNumeric(arr(v, 1)) Then
arr(v, 1) = "'" & CStr(arr(v, 1))
End If
Next
' ## Put the string data back out to the worksheet
tbl.DataBodyRange.Columns(1).Value = arr
tbl.Range.AutoFilter Field:=1, _
Criteria1:="*" & CStr([G1]) & "*", Operator:=xlFilterValues
I would like to write a VBA function, which outputs a list of all the single formulas and array formulas of a worksheet. I want an array formula for a range to be printed for only one time.
If I go through all the UsedRange.Cells as follows, it will print each array formula for many times, because it covers several cells, that is not what I want.
For Each Cell In CurrentSheet.UsedRange.Cells
If Cell.HasArray Then
St = Range(" & Cell.CurrentArray.Address & ").FormulaArray = " _
& Chr(34) & Cell.Formula & Chr(34)
ElseIf Cell.HasFormula Then
St = Range(" & Cell.Address & ").FormulaR1C1 = " _
& Chr(34) & Cell.Formula & Chr(34)
End If
Print #1, St
Next
Does anyone have a good idea to avoid this?
You basically need to keep track of what you've already seen. The easy way to do that is to use the Union and Intersect methods that Excel supplies, along with the CurrentArray property of Range.
I just typed this in, so I'm not claiming that it's exhaustive or bug-free, but it demonstrates the basic idea:
Public Sub debugPrintFormulas()
Dim checked As Range
Dim c As Range
For Each c In Application.ActiveSheet.UsedRange
If Not alreadyChecked_(checked, c) Then
If c.HasArray Then
Debug.Print c.CurrentArray.Address, c.FormulaArray
Set checked = accumCheckedCells_(checked, c.CurrentArray)
ElseIf c.HasFormula Then
Debug.Print c.Address, c.Formula
Set checked = accumCheckedCells_(checked, c)
End If
End If
Next c
End Sub
Private Function alreadyChecked_(checked As Range, toCheck As Range) As Boolean
If checked Is Nothing Then
alreadyChecked_ = False
Else
alreadyChecked_ = Not (Application.Intersect(checked, toCheck) Is Nothing)
End If
End Function
Private Function accumCheckedCells_(checked As Range, toCheck As Range) As Range
If checked Is Nothing Then
Set accumCheckedCells_ = toCheck
Else
Set accumCheckedCells_ = Application.Union(checked, toCheck)
End If
End Function
The following code produces output like:
$B$7 -> =SUM(B3:B6)
$B$10 -> =AVERAGE(B3:B6)
$D$10:$D$13 -> =D5:D8
$F$14:$I$14 -> =TRANSPOSE(D5:D8)
I'm using a collection but it could equally well be a string.
Sub GetFormulas()
Dim ws As Worksheet
Dim coll As New Collection
Dim rngFormulas As Range
Dim rng As Range
Dim iter As Variant
Set ws = ActiveSheet
On Error Resume Next
Set rngFormulas = ws.Range("A1").SpecialCells(xlCellTypeFormulas)
If rngFormulas Is Nothing Then Exit Sub 'no formulas
For Each rng In rngFormulas
If rng.HasArray Then
If rng.CurrentArray.Range("A1").Address = rng.Address Then
coll.Add rng.CurrentArray.Address & " -> " & _
rng.Formula, rng.CurrentArray.Address
End If
Else
coll.Add rng.Address & " -> " & _
rng.Formula, rng.Address
End If
Next rng
For Each iter In coll
Debug.Print iter
'or Print #1, iter
Next iter
On Error GoTo 0 'turn on error handling
End Sub
The main difference is that I am only writing the array formula to the collection if the current cell that is being examined is cell A1 in the CurrentArray; that is, only when it is the first cell of the array's range.
Another difference is that I am only looking at cells that contain formulas using SpecialCells, which will be much more efficient than examining the UsedRange.
The only reliable solution I see for your problem is crosschecking each new formula against the ones already considered to make sure that there is no repetition. Depending upon the amount of information and speed expectations you should rely on different approaches.
If the size is not too important (expected number of records below 1000), you should rely on arrays because is the quickest option and its implementation is quite straightforward. Example:
Dim stored(1000) As String
Dim storedCount As Integer
Sub Inspect()
Open "temp.txt" For Output As 1
For Each Cell In CurrentSheet.UsedRange.Cells
If Cell.HasArray Then
St = Range(" & Cell.CurrentArray.Address & ").FormulaArray = " _
& Chr(34) & Cell.Formula & Chr(34)
ElseIf Cell.HasFormula Then
St = Range(" & Cell.Address & ").FormulaR1C1 = " _
& Chr(34) & Cell.Formula & Chr(34)
End If
If(Not alreadyAccounted(St) And storedCount <= 1000) Then
storedCount = storedCount + 1
stored(storedCount) = St
Print #1, St
End If
Next
Close 1
End Sub
Function alreadyAccounted(curString As String) As Boolean
Dim count As Integer: count = 0
Do While (count < storedCount)
count = count + 1
If (LCase(curString) = LCase(stored(count))) Then
alreadyAccounted = True
Exit Function
End If
Loop
End Function
If the expected number of records is much bigger, I would rely on file storage/checking. Relying on Excel (associating the inspected cells to a new range and looking for matches in it) would be easier but slower (mainly in case of having an important number of cells). Thus, a reliable and quick enough approach (although much slower than the aforementioned array) would be reading the file you are creating (a .txt file, I presume) from alreadyAccounted.
I need an Excel macro to join seven columns of data on each row until the end of the data is reached. For example if I have a formula like this:
=A1&B1&C1&D1&E1&F1&G1
How can I write the macro so that it increments for every row to the end of the file in a sequence like this?
=A1&B1&C1&D1&E1&F1&G1
=A2&B2&C2&D2&E2&F2&G2
=A3&B3&C3&D3&E3&F3&G3
With so many answers, the main focus on what assylias and I were highlighting has gone to waste :)
However, if you still want a VBA answer. Use this method. This is much faster than Looping or an Autofill.
Option Explicit
Sub Sample()
Dim LastRow As Long
Dim Ws As Worksheet
Set Ws = Sheets("Sheet1")
LastRow = Ws.Range("A" & Ws.Rows.Count).End(xlUp).Row
'~~> If your range doesn't have a header
Ws.Range("H1:H" & LastRow).Formula = "=A1&B1&C1&D1&E1&F1&G1"
'~~> If it does then
Ws.Range("H2:H" & LastRow).Formula = "=A2&B2&C2&D2&E2&F2&G2"
End Sub
If you have 1000's of rows then you might want to switch off Screenupdating and change Calculation to Manual before you run the code and then reset them at the end of the code.
I think the easiest way to do this would be to just fill down as assylias says but if you want to use VBA:
Selection.AutoFill Destination:=Range("Your Fill Range"), Type:=xlFillDefault
Should copy across the other rows.
I agree 100% with the comments and the other answers, why do you need VBA to do this, but just to answer your original question, this is how I would accomplish it:
Sub FillAllWithFormula()
Dim i As Variant
Dim wsht As Worksheet
'If you are using this for a specific Worksheet use the following
Set wsht = ThisWorkbook.Worksheets(yourWorksheetName)
'or if you are always using this for the active sheet use the following
Set wsht = ActiveSheet
For i = 1 To wsht.Rows.Count
'Replace "X" with the column letter you want your formula to appear in
wsht.Range("X" & i).Formula = "=A" & i & "&B" & i & "&C" & i & "&D" & i & "&E" & i & "&F" & i & "&G" & i
Next
Set wsht = Nothing
End Sub