I have the following table, Column(Dates), Rows(Id and Names). I am trying to add the values in each row only if there are seven consecutive values in them otherwise not. Never done any coding in vba so I am having hard time. Tried to write the formula and vba code but not knowing the syntax it's been very difficult.
Scan from C2 to AG2
if C2 is > 0 and C2=D2=E2=F2=G2=H2=I2 then
add C2+D2+E2+F2+H2+I2 store this value in AL2
Repeat the process until last filled row
Any insight into this would be greatly appreciated. I tried extensive search on this site and on google but couldn't find anything that is close to what I am doing, I was able to learn how to get the last filled column (in my case it only goes up to AH), last filled row (in my case it only goes up to 55), for loop. but not able to put this together.
Thx,
Archer
A VBA user-defined-function
EDIT: updated to ignore blanks
Function GetRun(rng, num)
Dim d, i As Long, c As Long, v, rv, tmp
d = rng.Value
v = Chr(0)
rv = ""
For c = 1 To UBound(d, 2) - 1
tmp = d(1, c)
'EDIT: skip blanks
If tmp <> v Or Len(tmp) = 0 Then
v = tmp
i = 1
Else
i = i + 1
If i = num Then
rv = v
Exit For
End If
End If
Next c
GetRun = rv
End Function
Use:
=GetRun(C2:AG2, 7)
Related
I have been working on getting a timesheet macro that will take a data dumps and make do a few things.
Ultimately I am not familiar with the syntax of VBA and have got close however am needing help with getting this finished.
Below will be my code and comments where I am working on code as well as a screenshot for reference of the spreadsheet.
My question is how do I properly write the syntax using vars?
For instance in this line of code: If IsNumeric(Cells("Fr").Value) Then
I am geting errors and am unsure how I would enter the r value from the loop.
This applies to a few of the other lines I was getting errors for but didn't know
how to use r to identify a row.
Sub sum()
Dim r As Integer, c As Integer, s As Double, t As Integer, g As Integer
r = 2 'looping var
c = 3 'looping var
s = 0 'var for sum
g = 0
t = ActiveSheet.UsedRange.Rows.Count 'var for total rows
Do Until r = t
If Not IsEmpty(Range("Ar").Value) = True Then 'check if user name is present then
'Detect the next cell that contains data in the user name column
'Use that number between the two as a var (g) that will be used to run the embedded looping
'essentially redefining the other loop each time to account for the different number of clock ins per user
Do Until c = g 'Loop for until the next name was detected via var (g)
If IsNumeric(Cells("Fr").Value) Then 'check if Billable has a number then
s = s + Range("r, F").Value 'adds cell value (numbers only) to sum
c = c + 1 'add 1 to the value of c
Loop 'closes embedded loop once values have been added up
Range("Fr") = s 'Replace Cell (Fr) with the sum value
s = 0 'reset the value of the sum
r = r + 1
Loop
End Sub
I'm trying to solve a problem in VBA and after a long time of browsing the web for solutions, I really hope someone is able to help me.
It's actually not a very hard task, but with very little programming and VBA knowledge as a new learner, I hope I can find a useful tip or solution with the help of the community.
So my problem is as follows:
I have a table with 3 columns, the first is filled with a number to use as an ID. Column 2 and 3 have different values that needs to be compared:
What I'd like to do is select the range of column rows of column 2 and 3 based on the same ID. Once I have selected the relevant ranges of the columns, I want to compare if one name of column 2 matches one name of column 3.
So there is no need to have all names of the desired column ranges to match. One name match is enough. If a name matches, it should automatically fill in a new column "result" with 1 for match (0 for no match).
Do you have an idea, how I can select specific cells of a column based on an identifier?
Dim ID_counter As Long
ID_counter = 1
If Cell.Value = ID_counter IN Range("Column1")
Then Range("Column2").Select
AND Range("Column3").Select
WHERE ID_counter is the same
In Column4 (If one Cell.Value IN Range("Column2-X:Column2-Y")
IS IDENTICAL TO Range("Column3-X:Column3-Y"), return 1, else return 0
End Sub
Many thanks in advance for your help!
This works for your example so perhaps you can generalise it. The formula in D2 is
=IF(A2=A1,"",MAX(IF($A$2:$A$10=A2,COUNTIF($B$2:$B$10,$C$2:$C$10))))
and is an array formula so must be confirmed with CTRL, SHIFT and ENTER.
Array alternative via Match() function
This approach compares the string items of columns B and C by passing two arrays (named b,c) as arguments (c.f. section [1]):
chk = Application.Match(b, c, 0)
The resulting chk array reflects all findings of the first array's items via (1-based) position indices of corresponding items in the second array.
Non-findings return an Error 2042 value (c.f. section [2]b)); assumption is made that data are grouped by id.
Sub OneFindingPerId()
'[0]get data
Dim data: data = Sheet1.Range("A1:D10") ' << project's sheet Code(Name)
Dim b: b = Application.Index(data, 0, 2) ' 2nd column (B)
Dim c: c = Application.Index(data, 0, 3) ' 3rd column (C)
'[1]get position indices of identic strings via Match() function
Dim chk: chk = Application.Match(b, c, 0) ' found row nums of a items in b
'[2]loop found position indices (i.e. no error 2042)
Dim i As Long
For i = 2 To UBound(chk) ' omit header row
'a) define start index of new id and initialize result with 0
If data(i, 1) <> data(i - 1, 1) Then
Dim newId As Long: newId = i
data(newId, 4) = 0
End If
'b) check if found row index corresponds to same id
If Not IsError(chk(i, 1)) Then ' omit error 2042 values
If data(chk(i, 1), 1) = data(i, 1) Then ' same ids?
If data(newId, 4) = 0 Then data(newId, 4) = 1 ' ~> result One if first occurrence
End If
End If
Next i
'[3]write results
Sheet1.Range("A1").Resize(UBound(data), UBound(data, 2)) = data
End Sub
First enter this user defined function in a standard module:
Public Function zool(r1, r2, r3) As Integer
Dim i As Long, v1 As Long, v2 As String
Dim top As Long, bottom As Long
zool = 0
v1 = r1.Value
top = r1.Row
' determine limits to check
For i = top To 9999
If v1 <> r1.Offset(i - top, 0).Value Then
Exit For
End If
Next i
bottom = i - 1
For i = top To bottom
v2 = Cells(i, "B").Value
If v2 <> "" Then
For j = top To bottom
If v2 = Cells(j, "C").Value Then zool = 1
Next j
End If
Next i
End Function
Then in D2 enter:
=IF(OR(A2="",A2=A1),"",zool(A2,B2,C2))
and copy downwards:
(this assumes that the data has been sorted or organized by ID first)
I have a table with several week ending dates at the top of each column. I want to search a row for any column with data in and then return, in a list, all the column titles that had data in.
I have attached a picture to better show what I mean, in the picture I have simply typed the dates in. I would like a formula, maybe VBA? that can do this for me but its proving more difficult than I thought.
What final result should look like
Really appreciate any help!
Thanks
** edit: I have found a formula which works but will be incredibly long. Surely there is a way to combine and shorten?
=IF(C5<>0,TEXT(C1,"dd/mm")&" | ","")&IF(D5<>0,TEXT(D1,"dd/mm")&" | ","")&IF(E5<>0,TEXT(E1,"dd/mm"),"")
The above code only works in 3 columns too... Not the required 60 plus!
Paste this code into a module, and in cell B2 type =IFERROR(getNonBlankCells($C$1:$K$1,C2:K2),"") and drag it down to B5.
Function getNonBlankCells(Rng1 As Range, Rng2 As Range) As Variant
Dim i As Integer, j As Integer, n As Integer, test As String
Dim A As Variant, B As Variant, ret(), newret(), t As Integer, p As Integer
n = Rng1.Columns.Count
ReDim ret(1 To n, 0)
A = Rng1.Value2
B = Rng2.Value2
i = 1
For j = 1 To n
If B(1, j) <> "" Then
ret(i, 0) = A(1, j)
i = i + 1
End If
Next j
ReDim newret(LBound(ret) To UBound(ret))
For t = LBound(ret) To UBound(ret)
If ret(t, 0) <> "" Then
p = p + 1
newret(p) = ret(t, 0)
End If
Next t
ReDim Preserve newret(LBound(newret) To p)
getNonBlankCells = Join(newret, ", ")
End Function
Ive been trying to make something in Excel to find multiple combinations of sums.
I have list of numbers that needs to be added together to be either within ranges of 500-510 or 450-460.
Only two numbers from the list can be used to find the sum. the numbers can not be used more than once. and giving the combinations of multiple results would be great. and if a number is not used it is ok.
I've tried the solver add-in and some other tips I found from this site but could not find something that gives multiple answers.
Does anyone know if this will be possible?
I'd break this into 2 tasks. First would be to simply generate all of the index pairs to test in the input array. That's relatively simple with recursive procedure. This one uses a private Type to store the pairs, but it could adapted to use some other method of storing the pairs:
Private Type Tuple
ValueOne As Long
ValueTwo As Long
End Type
Private Sub FindCombinations(elements As Long, ByRef results() As Tuple, _
Optional ByVal iteration As Long = 0)
If iteration = 0 Then ReDim results(0)
Dim idx As Long
For idx = iteration To elements - 1
Dim combo As Tuple
With combo
.ValueOne = iteration
.ValueTwo = idx
End With
results(UBound(results)) = combo
If iteration <> elements And idx <> elements Then
ReDim Preserve results(UBound(results) + 1)
End If
Next
If iteration < elements Then FindCombinations elements, results, iteration + 1
End Sub
Then, you use a "entry-point" procedure to generate the index combinations, use those to index into your source array, and apply your selection criteria:
Private Sub FindMatchingSets(testSet() As Long)
Dim indices() As Tuple
FindCombinations UBound(testSet) + 1, indices
Dim idx As Long, results() As Tuple
For idx = LBound(indices) To UBound(indices)
Dim tupleSum As Long
tupleSum = testSet(indices(idx).ValueOne) + testSet(indices(idx).ValueTwo)
If indices(idx).ValueOne <> indices(idx).ValueTwo And _
((tupleSum >= 500 And tupleSum <= 510) Or _
(tupleSum >= 450 And tupleSum <= 460)) Then
Debug.Print testSet(indices(idx).ValueOne) & " + " & _
testSet(indices(idx).ValueTwo) & " = " & tupleSum
End If
Next
End Sub
It isn't clear what you intend to do with the results, so this simply outputs the calculated values to the Immediate Window. Example calling code:
Private Sub Example()
Dim test(4) As Long
test(0) = 100
test(1) = 200
test(2) = 250
test(3) = 260
test(4) = 400
FindMatchingSets test
End Sub
May modify it according to your need & try
Sub test()
Dim X, Y, TRw, GotNum, First, Second As Long
TRw = 1
With ThisWorkbook.ActiveSheet
For X = 1 To 100 ' assumed col A1 to A100 is the list
GotNum = .Cells(X, 1).Value
If (GotNum >= 450 And GotNum <= 460) Or (GotNum >= 500 And GotNum <= 510) Then
.Cells(X, 1).Font.Color = RGB(255, 0, 0)
First = GotNum
For Y = X + 1 To 100
GotNum = .Cells(Y, 1).Value
If (GotNum >= 450 And GotNum <= 460) Or (GotNum >= 500 And GotNum <= 510) Then
Second = GotNum
TRw = TRw + 1
.Cells(TRw, 3).Value = First ' write 1st Number in Col C
.Cells(TRw, 4).Value = Second ' write 2nd Number in Col D
.Cells(TRw, 5).Value = First + Second ' write Sum of 1st & 2nd in Col C
End If
Next Y
End If
Next X
End With
End Sub
I think your question needs to be a little clearer in terms of what your expected output is (do you want a list of combos, or just to see the results?), but here's my solution.
I've put a list of 20 numbers in column Y, and assigned them all a letter (a through to t) in column X
Then I've built a matrix of the combinations of a to t, and have entered the following formula (the below is for cell C3, but it can be copied and pasted into all parts of the matrix)
=IF(C$2=$B3,"x",VLOOKUP(C$2,$X:$Y,2,FALSE)+VLOOKUP($B3,$X:$Y,2,FALSE))
I've then used conditional formatting to set the colour of the cells if they meet your criteria for the sum - you can do this by highlighting all the sums (cell C3:V22) and going to
home / conditional formatting / new rule...
picking the rule type format only cells that contain
and then in the drop down menus picking Cell Value / Between / Your high range
and then selecting a format (fill background colour, usually)
Do this once for the "high" sum, and once for the "low" sum. You can make the colours the same or different, depending on what you want to see.
I've also for reference included a reference to what the number is in Row 1 and column A. The formula for row 1 is (example is for C1, but it can be copied across)
=VLOOKUP(C2,$X:$Y,2,FALSE)
And the formula for column A is (example for A3) =VLOOKUP(B3,$X:$Y,2,FALSE)
The advantage of this approach is that it's all in excel (no code required), but the disadvantage is that it's hard to get a list of results. You could use a different formula to just return the sum (e.g. return the text "205+298") when it meets one of the conditions, but then it's still a pain to get it out of the matrix format and into a single list. Much easier using VBA
I am trying to find the first four cells along a row that contain values and the type is Double. I want to add the values of the cells to an array and also locate the cells locations for future use. I need to work down 23 rows after as well. Some of the rows don't contain any values. The matrix starts with cell AB3
I've been trying to start with a For loop so I can work down the rows and then having a For loop inside that to create a new array every time I move to a new row.
The code I need looks something like this.
For i = 3 to 27
For j = 0 to 3
TIGA(j) = Range(Cells(i, j + 28), Cells(last cell)).Find(first
value and then the next three)
Again I need to work across from left to right in each row. First I need to add the first four values in a row to an array. Next I need to save the column number for each of the values because I need to know what column they're in later on in my code. After I get the information for one your I need to loop it down for the rest. The array with the values and any variable/array used for the cells location can be restarted every time the code loops through for the new row. Thank you!
Here's what's the data looks like.
I changed things up a bit, I think this should suffice:
Sub Test()
Dim TIGA As Variant, i As Long, j As Long, k As Long
ReDim TIGA(0 To 3)
For i = 3 To 27
k = 0
For j = 28 To 40
If Cells(i, j) <> "" Then
If IsNumeric(Cells(i, j)) = True And InStr(Cells(i, j), ".") > 0 Then 'make sure it's a double
TIGA(k) = Cells(i, j)
k = k + 1
If k = 3 Then
Exit For
End If
End If
End If
Next j
Next i
End Sub