I have a spread sheet that look like so:
Group | Name | Title
-----------------------------------
X WS -
X DH -
X M -
X DH -
X WS -
I want to loop through all the cells in name and replace the initial there with their full name in addition to adding the correct title. My script is failing to accurately compare the strings and go into the if-statement:
Sub enterNameAndTitle()
lastCell = InputBox("Last cell")
rInitials = InputBox("Initials")
rFullName = InputBox("Full Name")
rTitle = InputBox("Title")
Dim cell As Range
For Each cell In Range("b2:b" & lastCell).Cells
MsgBox (cell.Text & " : " & rInitials)
If StrComp(UCase(cell.Value), UCase(rInitials)) = 0 Then
cell.Value = rFullName
ActiveSheet.Cells(cell.Row, cell.Column + 1).Value = rTitle
End If
Next cell
End Sub
So I first collect the data and then loop through all the values. Does anyone know what I am doing incorrectly? Why doesn't it compare the string accurately?
I don't see anything wrong, but there are 2 things I would try
One is to use TRIM to make sure neither string has leading or trailing blanks
The 2nd is to change the if to if(ucase(trim(cell.value))=ucase(trim(rInitials)))
The problem was one of differing types and the only way that seemed to work for me was to re-cast both variables as type String using CStr()
Sub enterNameAndTitle()
Dim lastCell As String
lastCell = InputBox("Last cell")
'Cast to string
Dim rInitials As String
rInitials = CStr(InputBox("Initials"))
Dim rFullName As String
rFullName = InputBox("Full Name")
Dim rTitle As String
rTitle = InputBox("Title")
Dim cell As Range
For Each cell In Range("b2:b" & lastCell).Cells
Dim cellText As String
'Cast to string
cellText = CStr(cell.Text)
If (Trim(UCase(cell.Value)) = Trim(UCase(rInitials))) Then
MsgBox ("test1")
cell.Value = rFullName
ActiveSheet.Cells(cell.Row, cell.Column + 1).Value = rTitle
End If
Next cell
End Sub
Related
I am writing a little Excel-Macro with VBA. Now I would like to concat two Strings and save them into a String-Array.
What I got:
Dim rowNumberString As String
Dim colIndexString As String
Dim headerArray(1 To colIndexArrayRange) As String
colIndexNumber = 14
colCount = 5
rowNumberString = "12"
addAnotherColumnToArray = True
' Fill the column array with all the month's entries
While addAnotherColumnToArray
colCount = colCount + 1
colIndexNumber = colIndexNumber + 1
If colIndexArray(colCount) = "" Then
colIndexString = Split(Cells(1, colIndexNumber).Address(True, False), "$")(0)
colIndexArray(colCount) = colIndexString & rowNumberString
End If
Debug.Print colCount & "=" & colIndexArray(colCount)
If (colIndexNumber > 61) Then
addAnotherColumnToArray = False
End If
Wend
The output:
6=O
7=P
8=Q
9=R
10=S
11=T
12=U
' ....
So it seems that this line:
` colIndexArray(colCount) = colIndexString & rowNumberString`
is not concatenating the String the way it should. What did I do wrong? I thought the &-Operator would always work for Strings in VBA.
As I stated in my comment, you could be going about this in a completely different way.
Not sure what you are trying to accomplish, but a For...Next statement using Objects, rather than Strings should help you accomplish your task.
Option Explicit
Sub TEST()
Dim ws As Worksheet, Rng12 As Range, Cell As Range
Set ws = ThisWorkbook.Worksheets(1)
Set Rng12 = ws.Range("L12:Z12") 'Adjust your range
For Each Cell In Rng12
Debug.Print Cell.Address
Next Cell
End Sub
I am new to this. I am trying to find the lowest value in a cell with multiple values inside. For example,
48
44.50
41.00
37.50
I am trying to find 37.50. What should be the code for it?
Thanks
Based on your posted example:
Sub FindMin()
Dim s As String, CH As String
Dim wf As WorksheetFunction
Dim bry() As Double
Set wf = Application.WorksheetFunction
s = ActiveCell.Text
CH = Chr(10)
ary = Split(s, CH)
ReDim bry(LBound(ary) To UBound(ary))
For i = LBound(ary) To UBound(ary)
bry(i) = CDbl(ary(i))
Next i
MsgBox wf.Min(bry)
End Sub
This assumes that there is a hard return (ASCII-10) between the fields in the cell.
EDIT#1:
To make it into a function, remove the sub and replace with:
Public Function FindMin(r As Range) As Variant
Dim s As String, CH As String
Dim wf As WorksheetFunction
Dim bry() As Double
Set wf = Application.WorksheetFunction
s = r.Text
CH = Chr(10)
ary = Split(s, CH)
ReDim bry(LBound(ary) To UBound(ary))
For i = LBound(ary) To UBound(ary)
bry(i) = CDbl(ary(i))
Next i
FindMin = wf.Min(bry)
End Function
EDIT#2:
based on your comment, here is an example of input vs output:
Note that all the values are in a single cell and the values are separated by hard returns rather than spaces.
By code with same cell and a " " as delimiter to break
temp = Range("A1").Value
temp = Split(temp, " ")
Low = CInt(temp(0))
For i = 0 To UBound(temp) - 1
If CInt(temp(i)) < Low Then Low = CInt(temp(i))
Next
Range("a2").Value = Low
if they are in a range you can use a formula
=MIN(A1:A4)
This question is pretty close to one previously asked:
VBA/EXCEL: extract numbers from one cell that contained multiple values with comma
If you take the code from that answer and replace the comma with whatever is separating your values, you will be able to get access to them in VBA. Then you can write code to find the minimum.
You can make a macro to split the values for each cell you selected and then check for the highest value. And a quick check to make sure you are not parsing all the empty rows (when you selected a column).
The macro below will set the highest value in the next column.
Sub lowest()
Dim Values As Variant
Dim LowestValue As Double
Dim a As Range
Set a = Selection
For Each Row In a.Rows
For Each Cell In Row.Cells
LowestValue = -1
Values = Split(Cell.Value, Chr(10))
For Each Value In Values
If LowestValue = -1 Then
LowestValue = Value
ElseIf Value < LowestValue Then
LowestValue = Value
End If
Next
Cells(Cell.Row, Cell.Column + 1).Value = LowestValue
If IsEmpty(Cell.Value) Then GoTo EndLoop
Next Cell
Next Row
EndLoop:
End Sub
I am trying to concatenate numbers in cells A1:A100 in to a single string. How do I do that referencing another sheet.Code is as follows
Sheets("Current").Cells(1,1).Formula = "=CONCATENATE('Reference Sheet'!A1:A100)"
But I am not getting anything. Please help
Its a one-liner:
MsgBox Join(Application.Transpose(Range("A1:A100")), vbNullString)
Dim oRng As Range
Dim cel As Range
Dim concStr as String
Set oRng = Range("A1:A100")
concStr = vbNullString
For Each cel in oRng
concStr = concStr & cel.value
Next cel
''Do stuff with concStr
The CONCATENATE function doesn't work on a range but on separate cells, i.e. CONCATENATE('Reference Sheet'!A1,'Reference Sheet'!A2,'Reference Sheet'!A3). If you always have 100 cells then you could use a loop:
Dim x As Integer
Dim formulaString As String
formulaString= "=CONCATENATE("
For x = 1 To 100
formulaString= formulaString & "'Reference Sheet'!A" & x & ","
Next x
' Remove last comma
formulaString= Left(formulaString, Len(formulaString) - 1)
' Add closing bracket
formulaString= formulaString& ")"
Sheets("Current").Cells(1,1).Formula = formulaString
Work with arrays, first create an array to hold the input value "A1:A100".
Then convert all numbers to strings within the array and join the array to obtain the resulting string and enter it in the required cell.
For this code using worksheets named "Source" and "Target" (modify as required)
Pls check comments in the code and see
https://msdn.microsoft.com/en-us/library/office/gg264098.aspx
Sub Rng_ConcatenateValues()
Dim aArySrc As Variant, vArySrc As Variant, sAryTrg As String
Dim l As Long
With ActiveWorkbook
Rem Set Input Array
aArySrc = WorksheetFunction.Transpose(.Worksheets("Source").Range("A1:A100"))
Rem Convert values to string
For l = LBound(aArySrc) To UBound(aArySrc)
aArySrc(l) = CStr(aArySrc(l))
Next
Rem Join Array Values
sAryTrg = Join(aArySrc, Chr(133))
Rem Post Resulting Concatenation
.Worksheets("Target").Cells(1).Value = sAryTrg
End With
End Sub
This program aims to compare two named ranges in two sheets. If the cells values are found in both sheets it highlights cells in green otherwise in red.
In my code below, I get a logical error.
I compare the results in the two sheets manually but I get totally different results.
Public Sub FindBtn_Click()
range1Name = namedRange1TxtBox
range2Name = namedRange2TxtBox
sheet1Name = Sheet1txt
sheet2Name = Sheet2txt
Dim range1No(), range2No() As Variant
range1No() = Range(range1Name)
range2No() = Range(range2Name)
Dim i, j As Integer
Dim cell As Variant 'Range
For i = LBound(range1No()) To UBound(range1No())
For j = LBound(range2No()) To UBound(range2No())
Set cell = Worksheets(sheet1Name).Range(range1Name).Find(what:=Worksheets(sheet2Name).Range(range2Name).Cells(i, 1).Value, lookat:=xlWhole)
If Not cell Is Nothing Then ' if jde cell value is found in tops then green jde cell
Worksheets(sheet1Name).Range(range1Name).Cells(i, 1).Interior.ColorIndex = 4
Else
Worksheets(sheet1Name).Range(range1Name).Cells(i, 1).Interior.ColorIndex = 3
End If
Application.StatusBar = "Progress: " & i & " of " & UBound(range1No()) '& Format(i / 9331, "%")
Next j
Next i
Without spending a while on in, I'm not too sure what's actually wrong with your code. But how about doing it this way (I substituted strings in the variables so I could make it work locally).
Public Sub FindBtn_Click()
range1Name = "firstrange"
range2Name = "secondrange"
sheet1Name = "Sheet1"
sheet2Name = "Sheet2"
Dim range1cell As Range
Dim range2cell As Range
For Each range1cell In Range(range1Name)
range1cell.Interior.ColorIndex = 3
For Each range2cell In Range(range2Name)
If range1cell.Value = range2cell.Value Then
range1cell.Interior.ColorIndex = 4
Exit For
End If
Next range2cell
Next range1cell
End Sub
On looking closer, I notice that while you're looping through values of j you don't seem to refer to j anywhere else.
the following code solved my problem basicly I don't know how to use the find function properly. below a code that does the job :)
Thanks :)
Dim cell1 As Range, cell2 As Range
Dim add1 As Variant
With Worksheets("JDE").Range("JS_No")
For Each cell2 In Worksheets("TOPS").Range("TechID")
Set cell1 = .Find(cell2, LookIn:=xlValues)
If Not cell1 Is Nothing Then
add1 = cell1.Address
Do
cell1.Interior.ColorIndex = 4
cell2.Interior.ColorIndex = 4
Application.StatusBar = "Processing: " & add1
Loop While Not cell1 Is Nothing And cell1.Address <> add1
End If
Next cell2
End With
I am using a formula to show a cells formula in another cell.
I want to show the values of each reference in this formula, instead of the reference.
Ex:
=$R$16+R19*($T$15-$R$16)
Want it to be
=3+2*(4-2)
Function I am using now to show formula as it is
Function GetFormula(Cell As Range) As String
GetFormula = Cell.Formula
End Function
Here is a very basic example which can handle cases like
=B1+C1-D1/E1
=$B$1+C1*($B$1-$D$1)
=B1+C1-(D1/E1)
=B1+C1-(D1/E1)
=$B$1*C1*($B$1/$D$1)
Assumptions:
Let's say the above formulas are in cell A1 to A5
All cells are in the same sheet
There is no worksheet function like SUM, Vlookup etc
No Error handling done. Assuming that you will take care of it
Sample Worksheet
Code:
Sub Sample()
Dim i As Long
For i = 1 To 5
Debug.Print ConvertToValues(Range("A" & i))
Next i
End Sub
Function ConvertToValues(rng As Range)
Dim sTmp As String, sOpr As String, sOrig As String
Dim s As String, v As String
Dim MyAr
Dim i As Long
sOpr = "+,/,-,*,&,(,),{,},[,]"
MyAr = Split(sOpr, ",")
sTmp = Replace(rng.Formula, "$", "")
sOrig = sTmp
For i = LBound(MyAr) To UBound(MyAr)
sTmp = Replace(sTmp, MyAr(i), "SIDROUT")
Next i
MyAr = Split(sTmp, "SIDROUT")
For i = LBound(MyAr) To UBound(MyAr)
s = MyAr(i)
If Len(Trim(s)) <> 0 Then
v = Range(s).Value
sOrig = Replace(sOrig, s, v)
End If
Next i
If sOrig <> "" Then _
ConvertToValues = "=" & sOrig
End Function
Output
Note:
Let me know if the above code fails in a particular scenario and I will update the code.