I would like to ask help to sum all items under a merged cell.
Item looks like this:
June
0 1 2 3 4 5 6 7 8 9
2 3 4 5 6 7 8 9 0 1
June is a merged cell, and I want to sum all items under it.
Is this even possible?
This will work whether the cells are merged or un-merged. Say we have merged A1 through C2 with contents like:
The following UDF() will give the sum of the numeric values:
Public Function InternalSum(rin As Range) As Double
Dim v As String, CH As String, temp As String
Dim dot As String, L As Long, i As Long
Dim capture As Boolean
v = rin(1).Text
InternalSum = 0
dot = "."
temp = ""
capture = False
L = Len(v)
If L = 0 Then Exit Function
For i = 1 To L
CH = Mid(v, i, 1)
If IsNumeric(CH) Or CH = dot Then
capture = True
temp = temp & CH
If i = L Then
InternalSum = InternalSum + CDbl(temp)
End If
Else
If capture Then
capture = False
InternalSum = InternalSum + CDbl(temp)
temp = ""
End If
End If
Next i
End Function
Note that both:
=internalsum(A1)
and
=internalsum(A1:C2)
will work.
Related
The following code I have Will paste a value code of "01" to a cell and then skip 4 rows continuously, until reaching the end of count within the for loop. I want to run a similar loop for "02", but rather than "Step" (skip) 4 rows, I would like it to insert the value in 6 consecutive rows within the same column and then skip 3 rows continuously until reaching the end of count. I am 2 weeks new to vba, so I hope I am explaining this correctly.
Dim i As Long
If Sheet3.Range("C22").Value = "01" Then
For i = 3 To 202 Step 4
ActiveWorkbook.Sheets("CrewEntries").Cells(i, 6).Value = _
ActiveWorkbook.Sheets("MonData").Cells(22, 5).Value
Next i
ElseIf Sheet3.Range("C22").Value = "02" Then
For i = 3 To 152
ActiveWorkbook.Sheets("CrewEntries").Cells(i, 6).Value = _
ActiveWorkbook.Sheets("MonData").Cells(22, 5).Value
Next i
End If
Maybe like this:
Dim i As Long, v
v = ActiveWorkbook.Sheets("MonData").Cells(22, 5).Value
If Sheet3.Range("C22").Value = "01" Then
For i = 3 To 202 Step 4
ActiveWorkbook.Sheets("CrewEntries").Cells(i, 6).Value = v
Next i
ElseIf Sheet3.Range("C22").Value = "02" Then
For i = 3 To 152 Step 9 '6 filled + 3 empty = 9
ActiveWorkbook.Sheets("CrewEntries").Cells(i, 6).Value = v
Next i
End If
For such a kind of question, I would advise a while-loop, as in this piece of pseudo-code:
dim condition as boolean
dim loop_step, interesting_value as integer
condition = true
loop_step = 1 'just in order to be sure that it never is 0, this might create an infinite loop
interesting_value = 0 ' or some other initialisation value
while condition do
if <some_first_condition>
then
do_first_thing(interesting_value, ...)
loop_step = 3
else
do_second_thing(interesting_value, ...)
loop_step = 6
end if
interesting_value = interesting_value + loop_step
if <some_other_condition> then condition = false
Wend
Sub EarningCode()
Dim CpID As String
Dim i As Long
Dim p As Long
CpID = ActiveWorkbook.Sheets("MonData").Cells(22, 3).Value
For i = 3 To 452
If p = 9 Then
p = 1
Else
p = p + 1
End If
If p < 7 Then
ThisWorkbook.Worksheets("CrewEntries").Cells(i, 4).Value = "02"
End If
Next i
End Sub
I'm trying to format some number data. For each cell within the range I need to replace the first number only with the corresponding letter. 1 = A, 2 = B etc. and then delete the 2nd and 3rd numbers.
So for example:
11111 --> A11
12345 --> A45
23456 --> B56
56789 --> E89
Is there a simple way to do that with formatting? I only need to go up to E.
Here's a little VBA code to accomplish what you need:
s = "56789"
s = Chr(Asc(Mid(s, 1, 1)) + 16) & Mid(s, 4)
My suggestion would be
Option Explicit
Function conA_E(inp As String) As String
Dim res As String
Dim ch As String
On Error GoTo EH
ch = Left(inp, 1)
If ch <= 6 And ch >= 1 Then
res = Chr(Asc(Mid(inp, 1, 1)) + 16) & Mid(inp, 4)
Else
'res = ch & Mid(inp, 4) ' In Case 2nd and 3rd digit should always be deleted
res = inp ' No change if first digit is bigger than 5
End If
conA_E = res
Exit Function
EH:
conA_E = inp
End Function
Sub TestIt()
Dim inp As String
inp = "1214222"
Debug.Print conA_E(inp)
End Sub
I have in Column K:
K8 is 6384 i.e. =SUM(J1:J8)
K9 is 2598 i.e. =SUM(J2:J9)
K10 is 12176 i.e =SUM(J3:J10)
:
:
K5488
up to K5488 (No numbers in sequence, all different numbers)
The largest number appearing in K is 1 400 000.
I need in Column M: The prime factors of each number in K
e.g. K8 is 6384 then M8 should be 2,2,2,2,3,7,19
k9 is 2598 then M9 should be 2,3,433 etc.
I found the following code by John Coleman on your site (Mar 28) which tested well, but seeing I have no programming knowledge, I don't know how to modify it to use in my columns K & M setup.
Here's the sample code:
Function Factor(ByVal n As Long, Optional FirstTrial As Long = 2) As String
Dim i As Long
Dim t As Long
Dim limit As Long
Dim rest As String
Dim s As String
If n = 1 Then
Factor = n
Exit Function
End If
limit = Int(Sqr(n))
t = FirstTrial
Do While t <= limit
If n Mod t = 0 Then
rest = Factor(n / t, t)
If rest <> "1" Then
s = t & "," & rest
End If
Factor = s
Exit Function
Else
If t = 2 Then t = 3 Else t = t + 2
End If
Loop
'if we get here:
Factor = n
End Function
Function PrimeOrFactor(n As Long) As String
Dim s As String
s = Factor(n)
If n = 1 Then
PrimeOrFactor = "Neither"
ElseIf (s) = Trim(n) Then
PrimeOrFactor = "Prime"
Else
PrimeOrFactor = s
End If
End Function
Tested like:
Sub test()
Dim i As Long
For i = 1 To 20
Cells(i, 1) = i
Cells(i, 2) = PrimeOrFactor(i)
Next i
End Sub
The function you provided is a udf (user defined function) to be used in your worksheet.
If you put the functions you provided in a normal code module, you can enter the following in your worksheet in M8:
=Factor(K8)
and copy that function down to your desired range.
I have an 'X' amount of variables (likely to range between 3 to 20 options), which will be combined to calculate all possible combinations to meet a criteria. For every extra variable an extra loop is introduced, however I do not know if it possible to make the creation of loops dynamic (in excel VBA, the code doesn't have to be very fast).
To demonstrate:
I have var. A with h = 2, var. B with h = 3.
I would like to know all combinations which are equal to 10 or the best combination of the 2 variables.
In this case: option 1 = 5*A = 10, 3*B = 9,2*A and 2*B = 10, 3*A and 1*B = 9.
The code looks like this:
For A = 0 to 5
h = 0 'Reset previous h if solution is found
For B = 0 to 5
h_test = A * height(A) + B * heigth(B)
if h_test > 10
if h = 0 then
exit for
else
write h
exit for
end if
h = h_test
Next B
Next A
If another parameter is introduced (for example C = 4), the code is:
For A = 0 to 5
h = 0 'Reset previous h if solution is found
For B = 0 to 5
h = 0 'Reset previous h if solution is found
For C = 0 to 5
h_test = A * height(A) + B * heigth(B) + C * heigth(C)
if h_test > 10
if h = 0 then
exit for
else
write h
exit for
end if
h = h_test
Next C
Next B
Next A
In other words, I would like to know if it is possible to translate the pseudocode to real code:
For #parameter. = X
For loop1 = 1 to 5
h = 0
For loop2 = 1 to 5
h = 0
....
For loopX = 1 to 5
h_test = loop1 *parameter1 + loop2 * parameter 2 ...
+ loopX * parameter X
If h_test > 10
Somecode
exit for
End if
Next X
...
Next loop2
Next loop1
There are two distinct problems here. You didn't mention the first, and that is you also need to calculate a value with an indeterminate number of arguments. For that, you can use a ParamArray.
For example:
Public Function Sum(ParamArray args() As Variant) As Long
Dim i As Long
Dim operand As Integer
Dim result As Long
For i = LBound(args) To UBound(args)
result = args(i) + result
Next i
Sum = result
End Function
Which can be used and tested like this:
Public Sub Test()
Debug.Print Sum(1,2) '=> 3
Debug.Print Sum(1,2,3) '=> 6
End Sub
So, that takes care of that problem. Now, as for the problem you asked about, we'll take a similar approach. The key is to loop once for each argument you've received.
Public Sub Run()
NestedLoop 1, 2, 3
End Sub
Public Sub NestedLoop(ParamArray args() As Variant)
Dim result As Long
Dim a As Variant
a = args
Dim h_test As Long
Dim i As Long, j As Long
For i = LBound(args) To UBound(args)
For j = 1 To 5
result = 0
h_test = Sum(a)
If h_test > 10 Then
If result = 0 Then
Exit For
Else
Debug.Print result
Exit For
End If
End If
result = h_test
Next j
Next i
End Sub
Public Function Sum(args As Variant) As Long
Dim i As Long
Dim operand As Integer
Dim result As Long
For i = LBound(args) To UBound(args)
result = args(i) + result
Next i
Sum = result
End Function
I'm trying to write a UDF (user-defined function) to create an average for non-numeric data (I'm converting it into numeric form then back again at the end). I can get the UDF to work if I list individual cells; I get a #VALUE! error if I try to refer to a range of cells. There may be a mix of both ranges and individual cells to process.
Any ideas?
The code so far is below.
Function avlvl(ParamArray av() As Variant)
Dim a As Integer
'creates an average ks3 level from data in format "5a"
a = 0
n = 0
total = 0
Do While a < UBound(av()) + 1
'ignore blank or zero cells
If av(a) = 0 Or av(a) = "" Then
a = a + 1
Else
'convert data into numeric value - split into level and sub level
level = Val(Left(av(a), 1))
sl = Right(av(a), 1)
If sl = "c" Then
sublevel = 0
ElseIf sl = "C" Then
sublevel = 0
ElseIf sl = "b" Or sl = "B" Then
sublevel = 1 / 3
ElseIf sl = "a" Or sl = "A" Then
sublevel = 2 / 3
Else
sublevel = 0
End If
'score is numeric value of the data
score = level + sublevel
'total is teh toatl of the cells so far
total = total + score
a = a + 1
n = n + 1
End If
Loop
ave = total / n
'reconvert into format level and sublevel (a,b,c)
averagelevel = Application.WorksheetFunction.RoundDown(ave, 0)
asl = ave - averagelevel
If asl < 0.17 Then
averagesublevel = "c"
ElseIf asl < 0.5 Then
averagesublevel = "b"
ElseIf asl < 0.84 Then
averagesublevel = "a"
ElseIf asl < 1 Then
averagelevel = averagelevel + 1
averagesublevel = "c"
Else
averagesublevel = "c"
End If
avlvl = averagelevel & averagesublevel
End Function
What's going on is that the range is coming in as a single object of type Range, and your code is trying to treat is as though it is coming in as an array.
The best approach would be to create a new array within the body of the function, and then assign the elements in the range to the new array. You need to test for the type of the elements of the ParamArray. If an element is type String, then put it directly in the new array; if an element is type Range, loop through it, assigning its cell values to the new array.
Then you would do your processing on the new array.
The following code provides the machinery to pass in ranges as well as individual cells or values. I've not included your code but have indicated where it would go.
Function avlvl(ParamArray av() As Variant) As Variant
Dim a As Integer
Dim i As Long
Dim avArr()
Dim element As Variant
a = 0
i = 0
Do While a < UBound(av) + 1
If TypeName(av(a)) = "String" Then
avArr(i) = av(a)
i = i + 1
ElseIf TypeName(av(a)) = "Range" Then
For Each element In av(a)
ReDim Preserve avArr(0 To i)
avArr(i) = element
i = i + 1
Next
Else
avlvl = CVErr(xlErrValue)
Exit Function
End If
a = a + 1
Loop
i = 0
Do While i < UBound(avArr) + 1
'...
'now process the elements of avArr()
'...
i = i + 1
Loop
End Function
If you have a disjoint range of cells and you want to pass them to a UDF, one approach is to create a Defined Name and pass it to the UDF as a single argument.