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
Related
I'm running into trouble highlighting a column's used range. The following code creates copies of two worksheets, removes some values and then is supposed to highlight certain columns.
Sub CreateAnalysisSheets()
Dim cell, HlghtRng As Range
Dim i As Integer
Dim ref, findLast, findThis As String
Dim lastRow As Long
findLast = "2016"
findThis = "2017"
Application.ScreenUpdating = False
Sheets(1).Copy After:=Sheets(2)
ActiveSheet.Name = Left(Sheets(1).Name, InStr(1, Sheets(1).Name, " ")) & "Analysis"
Sheets(2).Copy After:=Sheets(3)
ActiveSheet.Name = Left(Sheets(2).Name, InStr(1, Sheets(2).Name, " ")) & "Analysis"
Sheets("RM Analysis").Select
For Each cell In ActiveSheet.UsedRange
If cell.Value = "NULL" Then
cell.ClearContents
End If
Next cell
For Each cell In Range("1:1")
ref = cell.Value
lastRow = Range("R" & Rows.Count & "C" & cell.Column).End(xlUp).Row
Set HlghtRng = Range(Cells(1, cell.Column) & Cells(lastRow, cell.Column))
If InStr(1, ref, findLast) > 0 And InStr(1, ref, "YTD") = 0 Then
HlghtRng.Interior.ColorIndex = 8
End If
Next cell
For Each cell In Sheets(4).UsedRange
If cell.Value = "NULL" Then
cell.ClearContents
End If
Next cell
Sheets("RM Analysis").Select
Application.ScreenUpdating = True
End Sub
The problem comes at lastRow = Range("R" & Rows.Count & "C" & cell.Column).End(xlUp).Row where I get an Method 'Range' of Object '_Global' Failed. I've tried searching for ways to fix this issue, but everything I've tried (ActiveSheet.Range and Sheets("RM Analysis").Range) has yet to work.
Anyone see where I'm going wrong here?
The xlR1C1 syntax is fouling up your request for the last non-blank cell.
lastRow = Cells(Rows.Count, cell.Column).End(xlUp).Row
I would highly recommend that you avoid relying on the ActiveSheet and use explicit parent worksheet references. This can be made quite simple using With ... End With and preceding all Range and Cells with a . like .Range(...) or .Cells(...).
Once you within a With ... End With statement, all of the references need to be prefaced with a .. Additionally, the following is not a string concatenation (e.g. &) but as .Range(starting cell comma ending cell) operation.
with worksheets("RM Analysis")
...
Set HlghtRng = .Range(.Cells(1, cell.Column), .Cells(lastRow, cell.Column))
...
end with
this should do
Columns(1).Interior.ColorIndex = 3
change the number of column as to the column you wanna highlit
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'm very new to macros (it's been a few days now!) but slowly working my way through. I'd like to create a macro that adds a value of 2 to a cell if column D contains the text "(2)" AND column AG contains the text "Adult".
I've created a macro that so far changes the value of the cell to 5 (instead of adding to it) if column D contains the text "(2)" - I've spent a while messing around with "And" functions but I can't seem to find a way to make it take into account the both the "(2)" text in the D column and the "Adult" text in the AG column (I can only make it search one or the other).
Here's my attempt (this doesn't include any of my failed attempts to include the "Adult" text):
Sub BUBFindGuests()
Dim SrchRng As Range
lastRow = Range("D" & Rows.Count).End(xlUp).Row
Set SrchRng = Range("D1:D" & lastRow, "AG1:AG" & lastRow)
For Each cel In SrchRng
If InStr(1, cel.Value, "(2)") > 0 Then
With cel.Offset(0, 39)
.Offset(-1, 0) = "5"
End With
End If
Next cel
End Sub
I'm basically just trying to work out how to include the "Adult" text from the AG column, and also how to make the macro add rather than change the end value. I'm also relatively certain that some parts of my code are unnecessary or clunky, but with my level of experience I'm unsure of how to correct that. Any help would be much appreciated.
Judging by your code, you want to add 2 to column C, if that's the case this should do the trick:
Sub BUBFindGuests()
lastRow = Sheets("SHEETNAME").Range("D" & Rows.Count).End(xlUp).Row
For x = 1 to lastRow
If InStr(1, Sheets("SHEETNAME").Cells(x, 4), "(2)") <> 0 _ 'Checks column D
And Instr(1, Sheets("SHEETNAME").Cells(x, 33), "Adult") <> 0 Then 'Checks column AG
Sheets("SHEETNAME").Cells(x, 3).Value = _
Sheets("SHEETNAME").Cells(x, 3).Value + 2 'Change 3 to the appropriate column
End If
Next x
End Sub
You can search for Adult just as you searched for the (2). Just use the InStr-function two times and combine the result-booleans. You can do that in two ways, logical with And or nested with two if-statements:
If InStrResult1 **And** InStrResult2 Then 'do stuff End If
If InStrResult1 Then If InStrResult2 Then 'do stuff End If End If
Sorry for the bad formation.
You can then store the current value of your cell in a variable. Then add 2 to that variable (myVariable = myVariable + 2) and then set its value to your cell instead of 5.
EDIT: It turns out I misread your question. See revised code.
Sub BUBFindGuests()
Dim SrchRng As Range
lastRow = Range("D" & Rows.Count).End(xlUp).Row
Set SrchRng = Range("D1:D" & lastRow, "AG1:AG" & lastRow)
For Each cel In SrchRng
If InStr(1, cel.Value, "(2)") > 0 And InStr(1, cel.Value, "Adult") > 0 Then cel.Offset(-1, 39).Value = .Offset(-1, 0).Value & "5"
Next cel
End Sub
I need your help please, I have 4 columns in an excel sheet and I need to compare them 2 by 2 i will explain to you :
In column A i have users(user1,user2,user3 ...)
In column B i have functionalities ( fonc1, fonc2, fonc3.....)
In column C i have users(user1,user2,user3 ...)
In column D i have functionalities ( fonc1, fonc2, fonc3.....)
The columns C and D are a new version of columns A and B in the columns C and D the users may change order or change functionalities .
When i execute my code i put the result in other new columns:
column F where i have the users
column G where i put the Deleted_functionalities
column H where i put the New_functionalities
The first problem is that the code doesn't get the users it get only the new and deleted functionalities. The second problem is that when the column A is more than column C where the users are stocked the code doesn't work. Can you please help me to find a solution? Thank you in advance .
Here is my code and the file I am working on :
Private Sub CommandButton2_Click()
Dim rngCell As Range
For Each rngCell In Range("B2:B2000")
If WorksheetFunction.CountIf(Range("D2:D2000"), rngCell) = 0 Then
Range("G" & Rows.Count).End(xlUp).Offset(1) = rngCell
End If
Next
For Each rngCell In Range("D2:D2000")
If WorksheetFunction.CountIf(Range("B2:B2000"), rngCell) = 0 Then
Range("H" & Rows.Count).End(xlUp).Offset(1) = rngCell
End If
Next
End Sub
and this is the excel file
http://www.cjoint.com/c/FCxnwjp22rv
try this
Private Sub CommandButton2_Click()
Dim ws As Worksheet
Dim cell As Range, funcCell As Range
Dim oldUserRng As Range, newUserRng As Range, reportRng As Range
Dim iReport As Long
Dim oldFunc As String, newFunc As String
Set ws = ThisWorkbook.Worksheets("users") '<== adapt it to your needs
With ws
Set oldUserRng = .Columns(1).Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeConstants, xlTextValues)
Set newUserRng = .Columns(3).Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeConstants, xlTextValues)
Set reportRng = .Range("F1:I1") '<== added one report column to account for unchanged functions
End With
reportRng.Value = Array("user", "deleted", "new", "same")
iReport = 1
For Each cell In oldUserRng
With cell
oldFunc = .Offset(, 1).Value
Set funcCell = FindAndOffset(newUserRng, .Value, 1)
If funcCell Is Nothing Then
reportRng.Offset(iReport) = Array(.Value, "", "", oldFunc)
Else
newFunc = funcCell.Value
If newFunc = oldFunc Then
reportRng.Offset(iReport) = Array(.Value, "", "", newFunc)
Else
reportRng.Offset(iReport) = Array(.Value, oldFunc, newFunc, "")
End If
End If
iReport = iReport + 1
End With
Next cell
For Each cell In newUserRng
With cell
Set funcCell = FindAndOffset(oldUserRng, .Value, 1)
If funcCell Is Nothing Then
reportRng.Offset(iReport) = Array(.Value, "", .Offset(, 1).Value, "")
iReport = iReport + 1
End If
End With
Next cell
End Sub
Not so sure it does what you need.
you'd better provide screenshots of "before" and "after" scenarios.
BTW, is it safe to assume that both old and new user columns cannot hold duplicates (i.e.: two or more "userX" in column A and/or column C?)
But it does speed up thing considerably since it iterates only through non empty cells.
I hope I get what you want to achieve. Does the following solve your problem?
Private Sub CommandButton2_Click()
Dim rngCell As Range
For Each rngCell In Range("A2:A20000")
If WorksheetFunction.CountIf(Range("C2:C20000"), rngCell) > 0 Then
Range("F" & Rows.Count).End(xlUp).Offset(1) = rngCell
Range("F" & Rows.Count).End(xlUp).Offset(0, 1) = rngCell.Offset(0, 1).Value
Range("F" & Rows.Count).End(xlUp).Offset(0, 2) = Application.WorksheetFunction.VLookup(rngCell.Value, Range("C2:D20000"), 2, 0)
ElseIf (rngCell <> "") Then
Range("F" & Rows.Count).End(xlUp).Offset(1) = rngCell
Range("F" & Rows.Count).End(xlUp).Offset(0, 1) = rngCell.Offset(0, 1).Value
End If
Next
For Each rngCell In Range("C2:C20000")
If (WorksheetFunction.CountIf(Range("A2:A20000"), rngCell) = 0 And rngCell <> "") Then
Range("F" & Rows.Count).End(xlUp).Offset(1) = rngCell
Range("F" & Rows.Count).End(xlUp).Offset(0, 2) = rngCell.Offset(0, 1).Value
End If
Next
End Sub
A user is only included in column F when he appears both in columns A and C.In case you want to include every user that is either in column A or C the code has to be altered.
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