I am totally new to VBA and I am struggling a little bit with one thing. I want to make a macro, which checks values in "M" column. If value is higher than 5, then print "hello". If not then print "x". Unfortunately, I only gets "x" back in selected cells.
Private Sub costam()
Dim i As Integer
Dim a As Integer
a = 13
For i = 1 To Range("M" & Rows.Count).End(xlUp).Row
If Cells(a, i).Value > 5 Then
Range(Cells(1, i), Cells(10, i)).Value = "hello"
Else
Range(Cells(1, i), Cells(10, i)).Value = "x"
End If
Next i
End Sub
I know this problem is silly and takes like 1 minute to solve, but I am trying to apply some alike problems but without any progress.
You could create a custom function for this workbook.
Public Function CustomFunction(myVal As Integer)
Dim myResult As String
If myVal > 5 Then
myResult = "Hello"
Else
myResult = "X"
End If
CustomFunction = myResult
End Function
Then, you would write a formula in the cell where you want the value to be returned.
=CustomFunction(A2)
Your custom function will need to be placed into a module.
Excel VBA User-Defined Functions Tutorial
Related
image worksheetI am setting up sheet with hotels details and column "D" has hospitals that are close by eg PMH,SCGH,FSH. What i am trying to do is search column "D" based on a cell value on same sheet. I have code below but it will only do what i want if the cells in column"D" are single entry eg pmh. I need to be able to search all the cells in Column "D" for any instance of the text.
Many Thanks for any assistance
`Option Explicit
Sub finddata()
Dim hospitalname As String
Dim finalrow As Integer
Dim i As Integer
Sheets("Results").Range("A4:D100").ClearContents
Sheets("Main").Select
hospitalname = Sheets("Main").Range("g3").Value
finalrow = Sheets("Main").Range("A1000").End(xlUp).Row
For i = 2 To finalrow
If Cells(i, 4) = hospitalname Then
Range(Cells(i, 1), Cells(i, 4)).Copy
Sheets("Results").Range("A4").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
End If
Next i
Sheets("Main").Range("g3").Select
End Sub
`
The two simplest ways to do this would be
Using the Like operator:
If Cells(i, 4).Value Like "*" & hospitalname & "*" Then
This method has the drawback that a hospital name of, for instance, PMH might be matched against another one such as SPMH.
Using the InStr function:
If Instr("," & Cells(i, 4).Value & ",", "," & hospitalname & ",") > 0 Then
In this line, I "wrap" both the cell being looked at, and the value being searched for, within commas so it ends up searching for the string (for instance) ",PMH," within the string ",PMH,SCGH,FSH,". InStr will return the character position at which a match occurs, or zero if no match is found. So testing for > 0 is testing whether a match occurred.
I am new to both VBA and stackoverflow. So please be patient ;).
I searched for a solution but could not find it.
My problem is as follows:
I have a column (A) with names and then a column (B) where some cells contain an "X" and others do not. I want to know which names have an "X" besides them.
Example:
I want now a string as a result, in one cell.
In this example:
Noah;Jacob;Elijah;Jayden
I got not very far.
For r = 1 To 20
If Cells(r, 2) = "X" Then A = Cells(r, 1) Else
Next
Then "A" is "Noah" and I can write it in a cell, but I want it to find all values and then write them combined, preferable seperated by ; in a cell.
Does anyone have any idea?
Create a string variable, then append your results to that variable based on "X" being in column B. Here's an example of how you could do it:
Sub Foo()
Dim i As Integer
Dim result As String
For i = 1 To 20
If UCase(Cells(i, 2).Value) = "X" Then
result = result & Cells(i, 1).Value & ";"
End If
Next
'// output the result to C1
Range("C1").Value = Left$(result, Len(result) - 1)
End Sub
Excel's native worksheet formulas do not handle concatenating an unknown number of strings together and compensating for the maximum number possible can get messy. A User Defined Function¹ (aka UDF) takes advantage of VBA's ability to process loops through a large number of rows while making numerical or string comparisons 'on-the-fly'.
build_List UDF
Function build_List(rNAMs As Range, rEXs As Range, vEX As Variant, _
Optional delim As String = ";", _
Optional bCS As Boolean = False)
Dim str As String, rw As Long, cl As Long
With rNAMs.Parent
Set rNAMs = Intersect(.UsedRange, rNAMs)
Set rEXs = .Cells(rEXs.Rows(1).Row, rEXs.Columns(1).Column). _
Resize(rNAMs.Rows.Count, rNAMs.Columns.Count)
End With
With rNAMs
For rw = .Rows(1).Row To .Rows(.Rows.Count).Row
For cl = .Columns(1).Row To .Columns(.Columns.Count).Row
If (.Cells(rw, cl).Offset(0, rEXs.Column + (cl - 1) - cl) = vEX And bCS) Or _
(LCase(.Cells(rw, cl).Offset(0, rEXs.Column + (cl - 1) - cl)) = LCase(vEX)) Then _
str = str & .Cells(rw, cl).Value & delim
Next cl
Next rw
End With
build_List = Left(str, Len(str) - Len(delim))
End Function
In D7 (as per image below) as,
=build_List(A:A, B:B, "x")
Applying the build_Lists UDf to your sample data
¹ A User Defined Function (aka UDF) is placed into a standard module code sheet. Tap Alt+F11 and when the VBE opens, immediately use the pull-down menus to Insert ► Module (Alt+I,M). Paste the function code into the new module code sheet titled something like Book1 - Module1 (Code). Tap Alt+Q to return to your worksheet(s).
Mate Juhasz answered the question very nice and simple, but now the answer dissapeared.
Mate wrote:
For r = 1 To 20
If Cells(r, 2) = "X" Then A = A & "; " & Cells(r, 1) Else
Next
And for me that solved it perfectly. Now "A" is a string as I wanted. Thank you so much!
Please be aware that I am working with a series of ~1000 line medical information databases. Due to the size of the databases, manual manipulation of the data is too time consuming. As such, I have attempted to learn VBA and code an Excel 2010 macro using VBA to help me accomplish parsing certain data. The desired output is to split certain characters from a provided string on each line of the database as follows:
99204 - OFFICE/OUTPATIENT VISIT, NEW
will need to be split into
Active Row Active Column = 99204 ActiveRow Active Column+3 = OFFICE/OUTPATIENT VISIT, NEW
I have researched this topic using Walkenbach's "Excel 2013: Power Programming with VBA" and a fair amount of web resources, including this awesome site, but have been unable to develop a fully-workable solution using VBA in Excel. The code for my current macro is:
Sub EasySplit()
Dim text As String
Dim a As Integer
Dim name As Variant
text = ActiveCell.Value
name = Split(text, "-", 2)
For a = 0 To 1
Cells(1, a + 3).Value = Trim(name(a))
Next a
End Sub
The code uses the "-" character as a delimiter to split the input string into two substrings (I have limited the output strings to 2, as there exists in some input strings multiple "-" characters). I have trimmed the second string output to remove leading spaces.
The trouble that I am having is that the output is being presented at the top of the activesheet, instead of on the activerow.
Thank you in advance for any help. I have been working on this for 2 days and although I have made some progress, I feel that I have reached an impasse. I think that the issue is somewhere in the
Cells(1, a + 3).Value = Trim(name(a))
code, specifically with "Cells()".
Thank you Conrad Frix!
Yah.. funny enough. Just after I post I have a brainstorm.. and modify the code to read:
Sub EasySplit()
Dim text As String
Dim a As Integer
Dim name As Variant
text = ActiveCell.Value
name = Split(text, "-", 2)
For a = 0 To 1
ActiveCell.Offset(0, 3 + a).Value = Trim(name(a))
Next a
End Sub
Not quite the colkumn1,column4 output that I want (it outputs to column3,column4), but it will work for my purpose.
Now I need to incorporate a loop so that the code runs on each successive cell in the column (downwards, step 1) skipping all bolded cells, until it hits an empty cell.
Modified answer to modified request.
This will start on row 1 and continue until a blank cell is found in column A. If you would like to start on a different row, perhaps row 2 if you have headers, change the
i = 1
line to
i = 2
I added a check on the upper bound of our variant before doing the output writes, in case the macro is run again on already formatted cells. (Does nothing instead of erroring out)
Sub EasySplit()
Dim initialText As String
Dim i As Double
Dim name As Variant
i = 1
Do While Trim(Cells(i, 1)) <> ""
If Not Cells(i, 1).Font.Bold Then
initialText = Cells(i, 1).text
name = Split(initialText, "-", 2)
If Not UBound(name) < 1 Then
Cells(i, 1) = Trim(name(0))
Cells(i, 4) = Trim(name(1))
End If
End If
i = i + 1
Loop
End Sub
just add a variable to keep track of the active row and then use that in place of the constant 1.
e.g.
Dim iRow as Integer = ActiveCell.Row
For a = 0 To 1
Cells(iRow , a + 3).Value = Trim(name(a))
Next a
Alternate method utilizing TextToColumns. This code also avoids using a loop, making it more efficient and much faster. Comments have been added to assist with understanding the code.
EDIT: I have expanded the code to make it more versatile by using a temp worksheet. You can then output the two columns to wherever you'd like. As stated in your original question, the output is now to columns 1 and 4.
Sub tgr()
Const DataCol As String = "A" 'Change to the correct column letter
Const HeaderRow As Long = 1 'Change to be the correct header row
Dim rngOriginal As Range 'Use this variable to capture your original data
'Capture the original data, starting in Data column and the header row + 1
Set rngOriginal = Range(DataCol & HeaderRow + 1, Cells(Rows.Count, DataCol).End(xlUp))
If rngOriginal.Row < HeaderRow + 1 Then Exit Sub 'No data
'We will be using a temp worksheet, and to avoid a prompt when we delete the temp worksheet we turn off alerts
'We also turn off screenupdating to prevent "screen flickering"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Move the original data to a temp worksheet to perform the split
'To avoid having leading/trailing spaces, replace all instances of " - " with simply "-"
'Lastly, move the split data to desired locations and remove the temp worksheet
With Sheets.Add.Range("A1").Resize(rngOriginal.Rows.Count)
.Value = rngOriginal.Value
.Replace " - ", "-"
.TextToColumns .Cells, xlDelimited, Other:=True, OtherChar:="-"
rngOriginal.Value = .Value
rngOriginal.Offset(, 3).Value = .Offset(, 1).Value
.Worksheet.Delete
End With
'Now that all operations have completed, turn alerts and screenupdating back on
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
You can do this in a single shot without looping using the VBA equivalent of entering this formula, then taking values only
as a formula
=IF(NOT(ISERROR(FIND("-",A1))),RIGHT(A1,LEN(A1)-FIND("-",A1)-1 ),A1)
code
Sub Quicker()
Dim rng1 As Range
Set rng1 = Range([a1], Cells(Rows.Count, "A").End(xlUp))
With rng1.Offset(0, 3)
.FormulaR1C1 = "=IF(NOT(ISERROR(FIND(""-"",RC[-3]))),RIGHT(RC[-3],LEN(RC[-3])-FIND(""-"",RC[-3])-1 ),RC[-3])"
.Value = .Value
End With
End Sub
I will use an example to illustrate my question:
I have many tables which their lines quantity is different.
I want to pull down the function until the end of the table.
For example:
A B
1 =1*2 // <- this is the function that I want to pull
2
3
4
The output should be:
A B
1 =1*2
2 =2*2
3 =3*2
4 =4*2
It is important that the pull length is determined by the last cell at column A (in this case it is 4)
Please also note that the function may be changed either, this should work for any function.
Thank you,
Doron
Here is an example of a macro that will autofill the value from cell B1 to the end of the column to the left of it (in this case column A).
Sub AutoFill()
Dim FillFrom As Range
Set FillFrom = ActiveSheet.Range("B1")
FillFrom.AutoFill Destination:=Range(FillFrom.Address, FillFrom.Offset(0, -1).End(xlDown).Offset(0, 1).Address)
End Sub
Try This:
Public Sub DoWhatIWantYouToDo()
Dim lr As Integer, i As Integer
lr = Sheets("Sheet1").UsedRange.Rows.Count
For i = 2 To lr
Sheets("Sheet1").Range("B" & i).Formula = "=" & " A" & i & "*2"
Next
End Sub
I need to hide a range of cells using a macro in excel. C11 contains the column index from where I need to start hiding the columns.
Sub test()
Dim i As Integer
Dim j As Integer
Dim rocket As Range
i = Range("c11").Value
j = 12
rocket = Range(Cells(5, i), Cells(5, j))
Range("Rocket").Select
Selection.EntireColumn.Hidden = True
End Sub
The code is giving some unexpected error and as I am a novice, so have no clue what needs to be done..
Tree steps to make your code working:
1st. Add Set key word in appropriate line which is necessary:
Set rocket = Range(Cells(5, i), Cells(5, j))
2nd. Rocket variable represents range, you will NOT need to call it in this way:
Range("Rocket")....
but
rocket....
3rd. Avoid Select method and Selection object always when possible. Therefore the last two lines replace with this single one (which implements 2nd step, too):
rocket.EntireColumn.Hidden = true
That last answer was awesome! Just for someone else's FYI, here is what worked in Excel 2007. The first line is always 3, but the ending line needed to be a variable. That's where I had the problem. THIS FIXED IT! The last 4 lines before the "End If" do the work. Hope this helps!
Dim RowsToHide As Range
Dim RowHideNum As Integer
' Set Correct Start Dates for Billing in New File
Workbooks("----- Combined_New_Students_Updated.xlsx").Activate
Sheets("2015").Activate
StartDateLine1 = Format(START_DATE_1, "ww") - 1 ' Convert Start Date to Week Number
StartDateLine1 = (StartDateLine1 * 6) - 2 ' Convert Start Date to Line Number
If StartDateLine1 >= "10" Then
Cells(4, "q").Value = ""
Cells(StartDateLine1, "q").Value = STATUS_1
Cells(StartDateLine1, "z").Value = "START DATE " + START_DATE_1
RowHideNum = StartDateLine1 - 2
Set RowsToHide = Range(Cells(3, "a"), Cells(RowHideNum, "ab"))
RowsToHide.Select
RowsToHide.EntireRow.Hidden = True
End If