Sub Table1()
Dim FirstTable As Table
Dim value1, value2 As Integer
Set FirstTable = ActiveDocument.Tables(1)
iLastRow = FirstTable.Rows.Count
value1 = Left(FirstTable.Rows(1).Cells(2).Range.Text, Len(FirstTable.Rows(1).Cells(2).Range.Text) - 2)
value2 = Left(FirstTable.Rows(2).Cells(2).Range.Text, Len(FirstTable.Rows(2).Cells(2).Range.Text) - 2)
Total = value1 + value2
End Sub
this was something I was trying to write and an error was occurring due to the vertically merged cells
Related
How to multiply a value of a row of a column to all the values in another column and do the loop for all rows.Then, at the end, sum the values in each row?
Here is an example.
Please note that I do not need to have or show these three columns (I, II, III). I just put them in there to show the steps.
Thanks a lot for your help!
The loop works only for the 1st two rows in Column 3..!!?
Dim i As Integer
For k As Integer = 0 To Data1.ColumnCount - 4
For j = 0 to Data1.Rows.Count - 2
Data1.Rows(j).Cells(2).Value = Data1.Rows(j).Cells(0).Value * _
Data1.Rows(j).Cells(1).Value
For i = 0 To EOF()
i = i + 1
Data1.Rows(j).Cells(3).Value = Data1.Rows(j).Cells(0).Value *_
Data1.Rows(k+i).Cells(1).Value + Data1.Rows(j).Cells(2).Value
Next i
Next j
Next k
This solution doesn't use a DataGridView (or GridView) but using arrays. The trick is creating a list of row, column and the multiplication result. See the table below to see how the list looks like. After the list is built, it's just grouping by the second value (row) and calculate the sum the third value.
Dim C1 = { 40, 30, 20, 10 } ' column C1
Dim C2 = { 1, 2, 3 } ' column C2
' to store the result of multiplication between C1 and C2
' first value is Column, second value is Row, third column is the multiplication result
Dim list = New List(Of Tuple(Of Integer, Integer, Integer))
For i = 0 To C2.Length - 1
For j = 0 To C1.Length - 1
list.Add(New Tuple(Of Integer, Integer, Integer)( i, i + j, C2(i) * C1(j) )) ' column, row, value
Next
Next
' to store sum of each row
' key is row, value is sum of the row
Dim dict = New Dictionary(Of Integer, Integer)
For Each row In list ' iterate each row in list
If dict.ContainsKey(row.Item2) ' if dictionary contains row number
dict(row.Item2) += row.Item3 ' add value to existing row
Else
dict.Add(row.Item2, row.Item3) ' add new row
End If
Next
For Each entry In dict
Console.WriteLine("Total Row {0} = {1}", entry.Key, entry.Value)
Next
Alternative using LINQ to get the sum.
Dim C1 = { 40, 30, 20, 10 } ' column C1
Dim C2 = { 1, 2, 3 } ' column C2
' to store the result of multiplication between C1 and C2
' first value is Column, second value is Row, third column is the multiplication result
Dim list = New List(Of Tuple(Of Integer, Integer, Integer))
For i = 0 To C2.Length - 1
For j = 0 To C1.Length - 1
list.Add(New Tuple(Of Integer, Integer, Integer)( i, i + j, C2(i) * C1(j) )) ' column, row, value
Next
Next
' LINQ sum
Dim result = From l In list
Group By l.Item2 ' group by row
Into Sum(l.Item3) ' sum of value
For Each row In result
Console.WriteLine("Total Row {0} = {1}", row.Item2, row.Sum)
Next
Spreadsheet version of the list with colored rows grouped by Row (2nd) column.
Result:
Total Row 0 = 40
Total Row 1 = 110
Total Row 2 = 200
Total Row 3 = 140
Total Row 4 = 80
Total Row 5 = 30
I hope you get the idea to implement this code in your project.
EDIT. Optimized solution with less looping.
Dim C1 = { 40, 30, 20, 10 } ' column C1
Dim C2 = { 1, 2, 3 } ' column C2
Dim dict = New Dictionary(Of Integer, Integer)
For i = 0 To C2.Length - 1
For j = 0 To C1.Length - 1
If dict.ContainsKey(i + j) ' if dictionary contains row number
dict(i + j) += C2(i) * C1(j) ' add value to existing row
Else
dict.Add(i + j, C2(i) * C1(j)) ' add new row
End If
Next
Next
For Each entry In dict
Console.WriteLine("Total Row {0} = {1}", entry.Key, entry.Value)
Next
Sample in Windows Form application. Add a DataGridView and a Button into the form.
Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
LoadInitialData()
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Calculate()
End Sub
Sub LoadInitialData()
DataGridView1.Rows.Clear()
DataGridView1.Rows.Add(40, 1)
DataGridView1.Rows.Add(30, 2)
DataGridView1.Rows.Add(20, 3)
DataGridView1.Rows.Add(10, Nothing)
End Sub
Sub Calculate()
Dim dict = New Dictionary(Of Integer, Integer)
For i = 0 To DataGridView1.Rows.Count - 1
For j = 0 To DataGridView1.Rows.Count - 1
' check if both are numbers
If IsNumeric(DataGridView1(0, i).Value) And IsNumeric(DataGridView1(1, j).Value) Then
Dim C1 = Convert.ToInt32(DataGridView1(0, i).Value) ' value of C1 from 1st column of outer loop
Dim C2 = Convert.ToInt32(DataGridView1(1, j).Value) ' value of C2 from 2nd column of inner loop
If dict.ContainsKey(i + j) Then ' check if dictionary has entry
dict(i + j) += C1 * C2 ' increment the value in dictionary
Else
dict.Add(i + j, C1 * C2) ' add new entry into dictionary
End If
End If
Next
Next
For Each entry In dict
' check if row in datagridview is lesser than dictionary entries
If DataGridView1.Rows.Count < dict.Keys.Count Then
DataGridView1.Rows.Add() ' add empty row
End If
DataGridView1(2, entry.Key).Value = entry.Value ' set value in 3rd column
Next
End Sub
End Class
Is there any other way to sum all the items on the combo box
I'm trying to sum all the value on the combo box
this is my code:
For a As Integer = 0 To ComboBox1.Items.Count - 1
Dim b As Integer
b = ComboBox1.Items(a)
MetroLabel12.Text = ComboBox1.Items.Count(0) + b
Next b
The following code will take the string value of each item and try to convert it to integer. If successful, it will add the result to result.
Dim result as Integer = 0
Dim num as Integer = 0
For Each s As String In ComboBox1.Items
num = 0
If Integer.TryParse(s, num) Then
result = result + num;
End If
Next s
My purpose is to split a task into constituent tasks and find the most important one.The macro is written in "May" sheet of workallotment.xlsm and the tasks are in tasks.xlsx
For example:
Constituents Constituents Important Imp
Praveen T1 T2 T3 T4 T5 T6 T1+T2+T3 =T5 T3+T5+T6 =T9 T1 T6
4 3 1 2 8 9
Karthik P1 P2 P3 P4 " among T1,T2,T3- T1 takes more time".its imp
6 3 2 2
Walter c1 c2 c3 c4
1 2 3 4
Arvind g1 g2 g3
2 1 3
Sreelatha h1 h2 h3
2 1 1
Code:
Sub workallotment()
Dim workallotmentWB, tasksWB As Workbook
Dim waSheet As Worksheet
Dim str(9) As String
Dim splitArray() As String, S(10) As String
Dim col_new As Integer
Dim wa_nameRng As Range
Dim r As Integer, max As Integer, imps As String
Dim wa_nameRow, wa_firstRow, wa_lastRow As Integer 'work allotment rows
Dim t_firstRow, t_lastrow As Integer 'task rows
Dim curTaskCol As Integer 'current task column
Dim wa_tmpcol As Integer 'work allotment, temp column
Set workallotmentWB = ThisWorkbook
Set tasksWB = Workbooks.Open("E:/tasks.xlsx")
'notes on data structure:
'- tasks workbook:
'first name starts in A1 of "Sheet1"
'- workallotment workbook:
'first name starts in A2 of Sheet named "workallotment"
'tasks are to be written starting in B2
'in Row 1 are headers (number of days)
t_firstRow = 1
wa_firstRow = 2
wa_nameRow = 0
Set waSheet = workallotmentWB.Worksheets("May") ' in this file - workallotment.xlsm
With tasksWB.Worksheets("May") ' in tasks.xlsx which is attached
'finding the last rows
t_lastrow = .Range("A1000000").End(xlUp).row + 1
wa_lastRow = waSheet.Range("A1000000").End(xlUp).row
'goes through all the names in tasks_Sheet1
For r = t_firstRow To t_lastrow Step 2
Set wa_nameRng = waSheet.Range("A:A").find(.Range("A" & r).Value, _
LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)
If Not wa_nameRng Is Nothing Then
wa_nameRow = wa_nameRng.row
curTaskCol = 2
wa_tmpcol = 2
Do While Not IsEmpty(.Cells(r, curTaskCol).Value)
For C = 1 To .Cells(r + 1, curTaskCol).Value
waSheet.Cells(wa_nameRow, wa_tmpcol).Value = .Cells(r, curTaskCol).Value
wa_tmpcol = wa_tmpcol + 1
Next C
curTaskCol = curTaskCol + 1
Loop
End If
Next r
End With
MsgBox ("done")
For r = t_firstRow To t_lastrow Step 2 ' loop to find importance
col = 2 'setting to initial col
curTaskCol = 17 ' position input - constituent jobs at 17th col in tasks.xls
Do While Not IsEmpty(tasksWB.Worksheets("May").Cells(r, curTaskCol).Value)
str(curTaskCol - 16) = tasksWB.Worksheets("May").Cells(r, curTaskCol).Value
' reading input to first array of string element
substr = Left(str(curTaskCol - 16), Application.WorksheetFunction.find("=", str(curTaskCol - 16)) - 1) ' if T1+T2=T3 it'll look before "=" symbol
MsgBox (substr)
splitArray() = Split(substr, "+") ' if T1+T2 it will be split as T1 & T2
For i = LBound(splitArray) To UBound(splitArray)
S(i + 1) = splitArray(i) ' assigning split elements to string array
Next i
For i = LBound(splitArray) To UBound(splitArray)
col_new = 2 ' checking from 2nd column
Do While Not IsEmpty(tasksWB.Worksheets("May").Cells(r, col_new).Value)
If (S(i + 1) = tasksWB.Worksheets("May").Cells(r, col_new).Value) Then 'initialising max and imps
imps = S(i + 1) ' most important job
max = tasksWB.Worksheets("May").Cells(r + 1, col_new).Value
End If ' maximum time taken for task
col_new = col_new + 1
Loop
For j = LBound(splitArray) To UBound(splitArray)
col_new = findcol(S(j + 1), r, tasksWB)
If (max < tasksWB.Worksheets("May").Cells(r + 1, col_new).Value) Then
max = tasksWB.Worksheets("May").Cells(r + 1, col_new).Value
imps = tasksWB.Worksheets("May").Cells(r, col_new).Value
End If
Next j
Next i
tasksWB.Worksheets("May").Cells(r, curTaskCol + 6).Value = imps
' assign most IMPORTANT task on 6th column from current column
curTaskCol = curTaskCol + 1 ' RUNTIME ERROR 1004
Loop
Next r
End Sub
Public Function findcol(S As String, row As Integer, theWB As Workbook) As Integer
Dim col As Integer, addr As Integer
col = 2 ' checking from column 2
'Set tasksWB = Workbooks.Open("E:/tasks.xlsx")
Do While Not IsEmpty(theWB.Worksheets("May").Cells(row, col).Value)
If (StrComp(Trim(S), Trim(theWB.Worksheets("May").Cells(row, col).Value)) = 0) Then
addr = col ' if task string is found in column
End If
col = col + 1 ' return column found
Loop
findcol = addr
End Function
Krishnan,
In your main proc workallotment you declare the variable tasksWB.
In your method 'findcol' you then reference tasksWB. It looks like you've pulled this code out of the main proc. The tasksWB only has scope within workallot and so you need to give findcol this object so it will have it within it's scope as well.
I would recommend that you pass the tasksWB into the method, as a third parameter.
Your method would then look as follows.
Edit for your comment of why findcol doesn't return. The Exit Function will ensure that the method is exited immediately after setting the return value. Without this you would end up in the asking for the correct task name again.
Public Function findcol(S As String, row As Integer, theWB as Workbook) As Integer
col = 2 ' checking from column 2
Do While Not IsEmpty(theWB.Worksheets("May").Cells(row, col).Value)
If (S = theWB.Worksheets("May").Cells(row, col).Value) Then
findcol = col ' if task string is found in column
Exit Function
End If
'MsgBox ("Enter correct task names") Not sure why this is here.
col = col + 1 ' return column found
Loop
End Function
and you'd call it with
col_new = findcol(S(j + 1), r, tasksWB) ' ERROR line function to find column of task string
This will ensure that you do not "leak" your variable definition into global scope, and that you also ensure that your method doesn't depend on external globals.
Edit 3:
Your findcol is still wrong.
Public Function findcol(S As String, row As Integer, theWB As Workbook) As Integer
Dim col As Integer
'******* you don't need this because you can exit early
'Dim addr As Integer
col = 2 ' checking from column 2
'***** THIS LINE NEEDS TO BE REMOVED because you are using theWB being passed in *****
'Set tasksWB = Workbooks.Open("E:/tasks.xlsx")
Do While Not IsEmpty(theWB.Worksheets("May").Cells(row, col).Value)
'****** this line must use theWB
'If (StrComp(Trim(S), Trim(tasksWB.Worksheets("May").Cells(row, col).Value)) = 0) Then
If (StrComp(Trim(S), Trim(theWB.Worksheets("May").Cells(row, col).Value)) = 0) Then
'************* you can exit early once you've found what you need.
'addr = col ' if task string is found in column
findcol = col
exit function
End If
col = col + 1 ' return column found
Loop
' You can exit early so don't need this.
' findcol = addr
End Function
You should probably do a check when you call the function that the value hasn't returned 0, eg
new_col = findcol( .... )
if new_col = 0 then
msgbox "couldn't find the column with that str" & S(j + 1)
end if
tasksWB isn't recognized in the findcol function as it is declared as Private (=Dim) in the main process.
Declare it at the top of your module, and it'll work! ;)
I am trying to pull data out of a large spreadsheet using VBA.
Column A contains ID's which can repeat depending on the data stored in it.
For example i have
ID Value1 Value2
1111 item1 item2
1111 item3 item4
2222 item3 item4
3333 item3 item4
3333 item3 item4
I enter the ID into a spreadsheet then want to use VBA to Vlookup the ID then pull the Values from column B and C into another spreadsheet.
Heres what i have
Sub populate()
Dim ID As String
Dim Value1 As String
ID = Range("D5")
Value1 = Application.WorksheetFunction.VLookup(ID, Worksheets("Required").Range("A4:J1913"), 2, False)
Response = Application.WorksheetFunction.VLookup(ID, Worksheets("Required").Range("A4:J1913"), 7, False)
Worksheets("Coversheet").Range("D8") = Value1
Worksheets("Coversheet").Range("D10") = Value2
Dim Value1address As Long
Value1address = VarPtr(Value1)
Worksheets("Coversheet").Range("D15").Value = Cells(Value1address).Offset(1, 0)
End Sub
The code works excatly how i want, except for the last 3 lines. I am trying to get an offset from Value1 by 1 row, however it is saving as a blank, and consequently puts a blank value into Cell D15.
Can anyone help me solve this problem, or how i can easily take data from the following rows after the Vlookup?
Use the worksheet's MATCH function to return the row number to an INDEX function while adding +1 to it.
with Worksheets("Required")
Worksheets("Coversheet").Range("D15").Value = _
Application.Index(.Range("B4:B1913"), Application.Match(ID, .Range("A4:A1913"), 0) + 1))
End With
If you are finding the row, then store it and keep reusing it.
Dim ID As String, val1 As String, val2 As String, val3 As String, rw As Long
ID = Range("D5")
With Worksheets("Required")
If Not IsError(Application.Match(ID, .Range("A4:A1913"), 0)) Then
rw = Application.Match(ID, .Range("A4:J1913"), 0)
val1 = .Cells(rw + 3, 2).Value
val2 = .Cells(rw + 3, 7).Value
val3 = .Cells(rw + 4, 2).Value
End If
End With
With Worksheets("Coversheet")
.Range("D8") = val1
.Range("D10") = val2
.Range("D15") = val3
End With
Native Worksheet formulas
This could also be handled by standard (non-array) worksheet formula. In D8, D10 and D15 as,
=INDEX(Required!$B$4:$B$914, MATCH($D$5, Required!$A$4:$A$914, 0))
=INDEX(Required!$J$4:$J$914, MATCH($D$5, Required!$A$4:$A$914, 0))
=IFERROR(INDEX(Required!$B$4:$B$914, AGGREGATE(15, 6, ROW($1:$911)/(Required!$A$4:$A$914=$D$5), 2)), "n/a")
I recommend using Power Query for this task (or Get&Transform if you're on 2016 already):
https://www.dropbox.com/s/my59casl9y8ac3y/SO_ExtractDataUsingVLookupAndOffset.xlsx?dl=0
Code is pretty short (i.e. for Var1):
let
Filter= Excel.CurrentWorkbook(){[Name="ID"]}[Content][Column1]{0},
Source = Excel.CurrentWorkbook(){[Name="Tabelle1"]}[Content],
#"Filtered Rows" = Table.SelectRows(Source, each [ID] = Filter)
in
#"Filtered Rows"
You have all formatting options for the output and the solution is fully dynamic:
I'm currently having a slight issue duplicating a row and incrementing the sequence number.
So based on a button click, this is how I'm duplicating row 0, duplicated only one time per click.
Dim dr As DataRow
For n As Integer = 0 To 0 ' how many dupes you want
dr = tbl.NewRow
For c As Integer = 0 To tbl.Columns.Count - 1 ' copy data from 0 to NewRow
dr.Item(c) = tbl.Rows(0).Item(c)
Next
tbl.Rows.Add(dr) ' add NewRow to datatable
Next n
Here's how I'm creating the sequence number, pads with leading zeros, which seems to increment, but only after I click the duplicate button, so essentially the last row added, it the duplicated row 0, but doesn't represent the new sequence number needed.
'UPDATE SEQUENCE NUMBER
i += 1
Dim value As Integer = i
Dim r As Integer
Dim decimalLength1 As Integer = value.ToString("D").Length + 7
Dim decimalLength2 As Integer = value.ToString("D").Length + 6
Dim decimalLength3 As Integer = value.ToString("D").Length + 5
Dim decimalLength4 As Integer = value.ToString("D").Length + 4
If i >= 0 And i <= 9 Then
'1 TO 9 FORMAT
DataGridView1.CurrentCell = DataGridView1.CurrentRow.Cells("sequence")
DataGridView1.Item(73, r).Value = value.ToString("D" + decimalLength1.ToString())
'Debug.Print(value.ToString("D" + decimalLength1.ToString()))
ElseIf i >= 10 And i <= 99 Then
'10 TO 99 FORMAT
DataGridView1.CurrentCell = DataGridView1.CurrentRow.Cells("sequence")
DataGridView1.Item(73, r).Value = value.ToString("D" + decimalLength2.ToString())
'Debug.Print(value.ToString("D" + decimalLength1.ToString()))
ElseIf i >= 100 And i <= 999 Then
'100 TO 999 FORMAT
DataGridView1.CurrentCell = DataGridView1.CurrentRow.Cells("sequence")
DataGridView1.Item(73, r).Value = value.ToString("D" + decimalLength3.ToString())
'Debug.Print(value.ToString("D" + decimalLength1.ToString()))
ElseIf i >= 1000 And i <= 9999 Then
'1000 TO 9999 FORMAT
DataGridView1.CurrentCell = DataGridView1.CurrentRow.Cells("sequence")
DataGridView1.Item(73, r).Value = value.ToString("D" + decimalLength4.ToString())
'Debug.Print(value.ToString("D" + decimalLength1.ToString()))
End If
Row 0 will always have a sequence number of 1, so in theory I need to start incrementing at 2.
Suggestions? Is there a better/cleaner way of doing this?
UPDATE 2
Dim startSeq As Integer = Convert.ToInt32(tbl.Rows(0).Item(73))
MsgBox("startSeq = " & startSeq)
For n As Integer = 0 To NumericUpDown1.Value - 1
MsgBox("n = " & n)
dr = tbl.NewRow
For c As Integer = 0 To tbl.Columns.Count - 1
dr.Item(c) = tbl.Rows(0).Item(c)
If c = "73" Then ' if this is the SEQ column,
' add the current seq val to the seq column
dr.Item(c) = (startSeq + n).ToString("00000000")
End If
Next c
tbl.Rows.Add(dr)
Next n
It seems like you should be able to add the sequencer as you create the duplicates. Perhaps make it a method and pass the index of the column which has the sequence string. Something like:
Private Sub DuplicateRows(ColIndx As Integer,
Dupes As Integer)
' start value is Row(0) + 1
Dim startSeq As Integer = Convert.ToInt32(tbl.Rows(0).Item(ColIndx )) + 1
For n As Integer = 0 to Dupes -1
dr = tbl.NewRow
For c As Integer = 0 To tbl.Columns.Count - 1
If c = ColIndx Then ' if this is the SEQ column,
' add the current seq val to the seq column
dr.Item(c) = (startSeq + n).ToString("00000000")
Else
' otherwise copy the data from Row(0)
dr.Item(c) = tbl.Rows(0).Item(c)
End If
Next c
tbl.Rows.Add(dr)
Next n
End Sub
This should initialize each new row with an incremented counter. Is there a better/cleaner way of doing this
a) you should be adding to the DataTable, not the DGV if it is bound
b) (startSeq + n).ToString("00000000") should work to do the padding etc instead of that ugly block of code.
c) Use Option Strict On. If c = "73" ... is nonsense which makes the compiler guess at your intentions. Its is bug food.
d) Hardcoding "73" may work this time, but previously you said it could be anywhere. The code below finds the sequence column based on the name so it can appear anywhere. Rather than a form level var, you could find it just before you make the dupes or even in the Dupes procedure.
e) Dim startSeq As Integer = Convert.ToInt32(tbl.Rows(0).Item(73)) if you examine the answer above, this should be ... + 1 to increment the first value.
Usage:
Private tbl As DataTable ' table loaded from flat file
Private SeqColIndex As Integer ' assigned somewhere to
' point to the "sequence" column
' method to load data
Dim connstr = "Provider=Microsoft.ACE.OLEDB.12.0;..."
Using cn As New OleDbConnection(connstr)
...
End Using
' FIND the sequence column for this session
For n = 0 To tbl.Columns.Count - 1
If tbl.Columns(n).ColumnName.ToLowerInvariant = "sequence" Then
SeqColIndex = n
Exit For
End If
Next
' later to add some rows
Private Sub ButtonAddRow_Click(...
DuplicateRows(SeqColIndex, NumericUpDown1.Value)
End Sub