Find all cell containing a substring and add them - excel

I want to add all cells that contains the word "WAGES" If a cell in column G contains the word "WAGES" the amount(column j) will be displayed. If there's 2 or more cells containing "WAGES" then their respective amounts will be added. Here's my code:
Dim i As Integer
Dim x As String, name As String
Dim a As Double, b As Double
x = "WAGES"
i = 3
Do Until Sheets("SHIPNET").Cells(i, 7) = ""
name = Sheets("SHIPNET").Cells(i, 7)
If InStr(1, name, x, 1) Then
a = Sheets("SHIPNET").Cells(i, 10).Value
i = i + 1
End If
If InStr(1, name, x, 1) Then
b = Sheets("SHIPNET").Cells(i, 10).Value
i = i + 1
End If
i = i + 1
Loop
Sheets("MACRO TEMPLATE").Cells(5, 3) = a + b
My code is only limited to 2 cell that contains "WAGES". Is there anyway to make it dynamic instead of finding 2 cells only?
In the picture's case, -28,622.20 and -50,372.64 will be added.

Why not use a SUMIF with wildcards?
One line of code to replace the whole thing.
Sheets("MACRO TEMPLATE").Cells(5, 3) = worksheetfunction.SumIf(Sheets("SHIPNET").Range("G:G"),"*WAGES*",Sheets("SHIPNET").Range("J:J"))

Related

Why does this vba macro ignores the value after an if else?

I have two columns, the first one is a date with Year/Month format and the other a numerical value of an evaluation that i have done. I want to get the average value for each month with a macro( i need to do it so many times an a lot of data on it). So, i decided to create an array of dates and a Matrix of evaluation results. The goal is to group all numeric values by date and get the average per month. The problem is that this code ignores the value when the actual and last cells are different.
Dim i As Integer 'number of rows
Dim J As Integer 'manage row change
Dim G As Integer 'manage column change
Dim Fecha(48) As String
Dim Matriz_FI(100, 100) As Double
'-------------------------------------------------------------- --
J = 0
G = 0
For i = 2 To 10
If i = 2 Then
Matriz_FI(J, G) = Sheets("Nueva Database").Cells(i, 11).Value
Fecha(J) = Sheets("Nueva Database").Cells(i, 3).Value
G = G + 1
Else
If (Sheets("Nueva Database").Cells(i, 3).Value = Sheets("NuevaDatabase").Cells(i - 1, 3).Value) Then
'Column change in Matriz_FI
Matriz_FI(J, G) = Sheets("Nueva Database").Cells(i, 11).Value
G = G + 1
MsgBox ("Same")
Else
'Row change in Matriz_FI
J = J + 1
Fecha(J) = Sheets("Nueva Database").Cells(i, 3)
G = 0
Matriz_FI(J, G) = Sheets("Nueva Database").Cells(i, 11).Value
MsgBox ("Different")
End If
End If
Next
End Sub

Excel subroutine to create all possible combinations from a data set excluding duplicates

Does anyone know a routine on how to get a data set composed by 7 columns into all possible combinations?
the combination is composed by 7 numbers like this--> 1|3|8|10|35|40|50
The routine needs to look into the first table and make a list of all possible combination excluding the duplicate numbers from the combination in the second table. Please see picture.
The table on the left contains the combination which need to be reshuffled, into the right table which contain all possible combinations.
I would do something like:
The number of options are 6^7 so there will be alot of cases: 279936
To get all of it, you should loop through them.
First we should find all the options.
To generate all the possible combinations including duplicates, the probles is the same as get all the may 7 digit long numbers in base 6 ( as we have 6 number in each column)
in newer excels you can use the BASE funtion, but if you can not access it you can use this:
if you cange a code a bit you can call the value of the original table instead of the 0-5 numbers.
Then just remove duplicates.
Sub generateAllBase6()
Dim i As Double 'number tries
Dim n As String ' the number of item from the column 1-7
For i = 0 To 279936 - 1
n = ConvertBase10(i, "012345")
For k = 1 To 7
If Len(n) < k Then
Cells(i + 2, k) = 0
Else
Cells(i + 2, k) = Right(Left(n, k), 1)
End If
Next k
Next i
End Sub
Public Function ConvertBase10(ByVal d As Double, ByVal sNewBaseDigits As String) As String
Dim S As String, tmp As Double, i As Integer, lastI As Integer
Dim BaseSize As Integer
BaseSize = Len(sNewBaseDigits)
Do While Val(d) <> 0
tmp = d
i = 0
Do While tmp >= BaseSize
i = i + 1
tmp = tmp / BaseSize
Loop
If i <> lastI - 1 And lastI <> 0 Then S = S & String(lastI - i - 1, Left(sNewBaseDigits, 1)) 'get the zero digits inside the number
tmp = Int(tmp) 'truncate decimals
S = S + Mid(sNewBaseDigits, tmp + 1, 1)
d = d - tmp * (BaseSize ^ i)
lastI = i
Loop
S = S & String(i, Left(sNewBaseDigits, 1)) 'get the zero digits at the end of the number
ConvertBase10 = S
End Function
I found the funcion here: http://www.freevbcode.com/ShowCode.asp?ID=6604

Create new table in excel from existing TABLE ,subject to pre-defined conditions

I have a table where user can insert multiple rows over multiple columns where some data is string and some numeric. I want to create a button such that when the user clicks it, it will create a new table on the same excel sheet but with some of the rows combined based on predefined condition.
Eg. The table "pre defined condition" states that alpha and gamma are similar and so on(it can many rows like this which show the conditions to combine rows..condition will always pertain to second row of the user defined table i.e table 1)...Table 1 will be created by a different user and he can enter as many rows as he wishes to. So using these 2 tables (Table 1 & Pre defined condition tabel) I want to create a new table which has certain rows combined with stringfrom two rows separated using "/" and numbers added.
The structure will remain the same for all tables.
Edit:One value in column 2 will always have same value in column 1.Basically column 2 is a dependent list(on column 1 ). There can be many pre -defined conditions and not just limited to 2 . Usually there won't be any duplicate values in column 2,but in case there are I want to combine them in a row at click of the button.
Table 1
A Alpha 100 1
B Beta 200 2
C Gamma 300 3
D Kappa 400 4
Pre Defined Condition
Alpha Gamma
Beta Kappa
Desired Output
A/C Alpha/Gamma 400 4
B/D Beta/Kappa 600 6
Assuming that your data starts in A2:D2 (A1:D1 left for titles), that you state two conditions (for example Alpha Gamma) in columns F and G (starting in the second row; first row left for titles), that there is a command button, and that the worksheet is named "Sheet1", the following code should do the trick.
Dim i As Integer
Dim j As Integer
Dim lLastRowPDC As Integer
Dim lLastRowData As Integer
Dim sConditions As String
Dim sOrigin As String
Dim sColumnA As String
Dim sColumnB As String
Dim iColumnC As Integer
Dim iColumnD As Integer
Private Sub CommandButton1_Click()
lLastRowPDC = Worksheets("Sheet1").Cells(2, 6).End(xlDown).Row 'Rows with Conditions, starting in the second row
lLastRowData = Worksheets("Sheet1").Cells(2, 1).End(xlDown).Row 'Rows with data, starting in the second row
For i = 2 To lLastRowPDC
sConditions = Worksheets("Sheet1").Cells(i, 6).Value & Worksheets("Sheet1").Cells(i, 7).Value 'create a string with the two conditions
sColumnA = ""
sColumnB = ""
iColumnC = 0
iColumnD = 0
For j = 2 To lLastRowData
sOrigin = Worksheets("Sheet1").Cells(j, 2).Value
If InStr(sConditions, sOrigin) > 0 Then
If InStr(sColumnA, Worksheets("Sheet1").Cells(j, 1).Value) = 0 Then
sColumnA = sColumnA & Worksheets("Sheet1").Cells(j, 1).Value & "/"
End If
If InStr(sColumnB, Worksheets("Sheet1").Cells(j, 2).Value) = 0 Then
sColumnB = sColumnB & Worksheets("Sheet1").Cells(j, 2).Value & "/"
End If
iColumnC = iColumnC + Worksheets("Sheet1").Cells(j, 3)
iColumnD = iColumnD + Worksheets("Sheet1").Cells(j, 4)
End If
Next j
sColumnA = Left(sColumnA, Len(sColumnA) - 1) 'remove last "/"
sColumnB = Left(sColumnB, Len(sColumnB) - 1) 'remove last "/"
Worksheets("Sheet1").Cells(i, 8).Value = sColumnA
Worksheets("Sheet1").Cells(i, 9).Value = sColumnB
Worksheets("Sheet1").Cells(i, 10).Value = iColumnC
Worksheets("Sheet1").Cells(i, 11).Value = iColumnD
Next i
End Sub

Generation of sequential serial number based on prefix value

We have prefix defined already (say ABC, GIJ, THK, JLK ...so on) and want to create a sequential number when a user wants to generate a number for each of these prefix like given below:
ABC0000 , ABC0001 , ABC0002 ...ABC9999 same for GIJ0000 , GIJ0001 , GIJ0002 ...GIJ9999.
Given below is the code written for the above logic, but it does not achieve the requirement:
Private Sub CommandButton1_Click()
With ComboBox1.Value
Dim a, b As String
Dim i, j, k, l, x, q, m, temp As Long
a = ComboBox1.Text
i = Application.WorksheetFunction.Match(a, Range("A1:A1000"), 0)
j = Cells(i, 2)
l = j * 1000
For q = 2 To 100
For m = 2 To 100
If Cells(q, m).Value < 0 Then
k = m
End If
Next
Next
x = l
If Cells(i, GC).Value = temp Then
click = click + 1
Else
click = 0
End If*
Cells(i, GC) = x + click
TextBox1.Text = x + click
temp = Cells(i, GC).Value
End With
GC = GC + 1
End Sub
VBA does not seem necessary for this. Assuming you have your prefixes in separate cells in ColumnA starting in Row1, put in B1:
=A1&TEXT(COUNTIF(A$1:A1,A1)-1,"0000")
and double-click its fill handle.
From your code, I assume that you have a ComboBox named ComboBox1, a CommandButton named CommandButton1 and a TextBox named TextBox1, all on a UserForm, and with ComboBox1 filled with the possible values for prefixes.
The following code will put the next available code(1) for the selected prefix into the TextBox.
Private Sub CommandButton1_Click()
Dim a As String
Dim i As Long, j As Long
a = ComboBox1.Text
i = Application.WorksheetFunction.Match(a & "9999", Range("A1:A1000"), 1)
j = CLng(Mid$(Cells(i, 1).Value, Len(a) + 1)) + 1
TextBox1.Text = a & Format(j, "0000")
End Sub
Your code is also doing a lot of unnecessary stuff.
(1) only if data is sorted.

Vba how to compare 2 column

I'm making an heuristic analyse and i have the fallowing problem : I want to find in column D numbers that match with column J and replace them by a "0". You can see what I'm trying to do on this image :
Problem : Column D have multiples values per cell and column J have one value per cell.
some part of the code:
Dim i,j As Integer
Dim temp As String
Dim x As Integer
Dim d As String
i = Application.CountA(Range("E:E")) + 10
'number of cell with values
j = Application.CountA(Range("J:J")) + 10
For j = 11 To j
temp = Range("J" & j).Value
For i = 11 To i
d = Range("D" & i).Value
*For x = LBound(vec) To UBound(vec)
If vec(x) = temp Then
vec(x) = 0
Range("D" & i).Value = vec(x)
End If
Next
Next
Next
*-> Here it is the problem, i cant figured out how to pass over the coma "," in column D,and store the data. I want to compare the temp with value on "d", but "d" can i have multiple numbers on the same cell, like " 3, 2, 1", and if there is any match like temp = 3, then d= "0,2,1".
English is not my native language so i hope you can understand what i want.
Thanks!
I think your almost there you just need to split up each cell and then search then recreate and replace the string in the cell. Please note I've not tested this.
Dim i,j As Integer
Dim temp As String
Dim x As Integer
Dim d As String
i = Application.CountA(Range("E:E")) + 10
'number of cell with values
j = Application.CountA(Range("J:J")) + 10
For j = 11 To j
temp = Range("J" & j).Value
For i = 11 To i
d = Range("D" & i).Value
Vec = split(d, ",") 'split the cell
d = "" 'clear the string
For x = LBound(vec) To UBound(vec)
If vec(x) = temp Then
vec(x) = 0
End If
d = d & vec(x) & "," 'recreate the string
Next
Range("D" & i).Value = left(d, len(d) - 1) 'save the string without the last ,
Next
Next
you can do this with the below formula - no need for VBA
Make a new column somewhere near column D.
In your new column, use this FIND and Substitute formula:
=IF(NOT(ISERROR(FIND(J:J,D:D))),SUBSTITUTE(D:D,J:J,"0"),D:D)
This formula looks for the value in column J within the cells in column D.
If a match is found, 0 is substituted for the found number. Otherwise, column D is returned.
If you want, you can hide column D to avoid confusion.
in VBA you have a string function called Split(vString, delimiter) that will split a string into tokens using the specified delimiter. See
MSDN Library: VB Split Function
examples:
Mr Spreadsheet John Walkenbach: Split Function examples
VB-Helper

Resources