I am trying to write a program to create a Microsoft Word document from an Oracle table.
The document has tables with the left hand column which represents group field name and the next column has some fields associated with that group. I don't want the groups to split across pages. My code for doing this doesn't appear to work - the groups are still split across pages.
Does anyone know how to do this?
'output table data - data gets loaded into the display table starting at row 3
'(row 1 and 2 are the headers)
For row = 3 To maxrows + 2
Dim dataRow = dsHDTabCols.Tables(0).Rows(row - 3) 'dataset has rows to output
If dataRow("KEEP_WITH_NEXT_FLAG") & "" = "K" Then
oTable.Cell(row, 1).Range.ParagraphFormat.KeepWithNext = True
End If
If dataRow("GROUP_NAME") & "" = "#ditto#" Then
VerticalMergeWithPriorRow(oTable, row, 1)
Else
oTable.Cell(row, 1).Range.Text = dataRow("GROUP_NAME") & ""
End If
oTable.Cell(row, 2).Range.Text = dataRow("COLUMN_NAME") & ""
Note that I am vertically merging cells, so I am limited to using the table.cell references.
Table.rows(nnn)` gives an exception.
The data processed by the code above starts with a data row with the keep_with_next_flag set to "K", so the code sets the cell paragraph format keepwithnext = true.
The next data row in a group would come with the group name = "#ditto#" and a keep_with_next_flag set to "K". As above, the code sets the cell paragraph format with keepwithnext = true. Since it's a ditto, the code will execute the VerticalMergeWithPriorRow function which just merges the current cell with the cell in the same column, but prior row.
Related
I need to add a row after first row in MSWord Document. Document have already one row and two columns containing Country in first cell and Partner in second cell as values of both cells. Problem with the following code is it only work with at-least two rows.
Macro should be able to add row and write predefined strings in both columns. This can be done in two ways
By adding a row at the end of the table and reaching to it and writing the strings. If i do this then my question is how can I reach to the last row of the table?
By adding second row Everytime as mentioned in the following code.
Set doc = Documents.Open("C:\Users\dell\Desktop\LATAM.DOCX", , , , , , , , , , , True)
Set rng = doc.Content
rng.Tables(1).Rows.Add (rng.Tables(1).Rows(2)) 'Here I am getting error 'required memeber of collect not exist.
Set Cell = rng.Tables(1).Cell(2, 1)
Set Cell2 = rng.Tables(1).Cell(2, 2)
Cell.Range.Text = UT
If UT = "CROATIA" Then Cell2.Range.Text = "ERSTE SECURITIES ZAGREB"
If UT = "CZECH REPUBLIC" Then Cell2.Range.Text = "ERSTE GROUP"
Latam.docx look like this:
Requirement: After Macro it should be like this with values in added cells.
UPDATED ANSWER:
Set doc = Documents.Open("C:\Users\ibnea\Desktop\List of Countries & Companies CEEMEA & LATAM.DOCX", , , , , , , , , , , True)
Set rng = doc.Content.Tables(1).Rows.Add
rng.Range.Font.Bold = False
rng.Cells(1).Range = UT
rng.Cells(2).Range = UT2
Maybe I don't really understand your question but when I open a Word File and create a table with 1 row (as header) and 2 columns and enter "Country" and "Partner" then I can create a new row in this table with this code:
Option Explicit
Sub addRow()
Dim tbl As Table
'set tble variable to Table with Index 1 in your document
Set tbl = ActiveDocument.Tables(1)
'add a row to this table at the end
tbl.Rows.Add
'get last row in this table
Dim lastRow As Variant
lastRow = ActiveDocument.Tables(1).Rows.Count
'write to the last row
ActiveDocument.Tables(1).Cell(lastRow, 1).Range = "your value in last row / column 1"
ActiveDocument.Tables(1).Cell(lastRow, 2).Range = "your value in last row / column 2"
End Sub
You said your list has only one row. This code now adds a row and fills in column 1 and 2 the value whatever is on the right side of the equality sign. It's still not clear what UT is and where it comes from. But anyway you can now access the last cells with this code.
Use Rows.Add without a parameter and the new row will be inserted at the end of the table. The parameter (as stated in the Help topic for Rows.Add enables code to insert new rows before a specific row.
In order to work with the new row, declare an object variable and assign the row to it when it's created. It's also a good idea to do this with the Table object. That way it's possible to address the objects directly, rather than needing to always use something like rng.Tables(index).Rows(index) not only is this simpler to read and write, it also executes more quickly.
So, based on the code in the question my recommendation:
Dim tbl as Word.Table, rw as Word.Row
Set tbl = rng.Tables(1)
Set rw = tbl.Rows.Add
rw.Cells(1).Range.Text = "cell content"
rw.Cells(2).Range.Text = "other cell content"
I have been trying to learn visual basic to write code to perform tasks when working with data in excel. I have been mostly copying snippets of code I find online and piecing them together. Currently, I have folders containing 10's of thousands of .csv files (data output from a CMM).
In each of these files column A consistently contains labels for the data and column B consistently contains the CMM data.
Currently, my program allows a user to select multiple .csv files and in a long roundabout way they all end up on one worksheet in excel with the data labels in the first column and the data in the next columns.
For example, if 10 CSV files are opened the data labels would be in the first column and the data would be in the next 10 columns.
The problem is that that the data labels are not aligned with the data and often each row of data has multiple labels.
I have been able to concatenate the data labels into one label for each row of data but cannot figure out how to align this label with the row of data.
At this point, I would be happy with a separate block of code that accomplishes this but... I suspect that my block of code that concatenates the labels could be easily modified to accomplish the task, I just haven't been able to figure it out.
So my code spits this out:
(Flatness) : Item (113)
Plane:RH_5_Mating_Surface
5.012 4.014 6.313 etc...
(Z) : Item (128) / (X) : Item (135)
Circle:Offset_Dowel_Hole
1.012 2.987 5.478 etc...
Circle:Cast_Hole_From_Offset_Dowel_Hole
2.147 7.895 4.258 etc...
Then this code concatenates the labels and spits them out in column B:
Dim rng1 As Range
Dim Lastrow As Long
Dim c As Range
Dim concat As String
Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
Set rng1 = Range("A9:A" & Lastrow)
concat = ""
For Each c In rng1
If c > 0 Then
concat = concat & " " & c.Value
concat = Trim(concat)
Else
c.Offset(-1, 1).Value = concat
concat = ""
End If
Next c
The result is:
(Flatness) : Item (113) Plane:RH_5_Mating_Surface
5.012 4.014 6.313 etc...
(Z) : Item (128) / (X) : Item (135) Circle:Offset_Dowel_Hole
1.012 2.987 5.478 etc...
Circle:Cast_Hole_From_Offset_Dowel_Hole
2.147 7.895 4.258 etc...
What I need is:
I cant figure out how to show it here but...
I need the rows to match up, also note, here it shows that the data and labels are offset by the same amount but in reality they are not. So my thinking is that I need it to search for the next row containing data and put the label next to it.
I feel like I can just change this part...
Else
c.Offset(-1, 1).Value = concat
but I don't know how to do...
I tried nesting another "For Each" here instead similar to what its already doing but with a "For Each d In rng2" where "rng2" was the data column and it would look for the next row with data and place "concat" next to the data using "d.offset(-1, -1).Value = concat"
I couldn't figure out how to get it to work...
This is one possible way of doing it.
Delete the empty cells and shift up in the columns. If the data order is consistent, they should line up correctly.
For i=1 to Lastrow
If Range("A" & i).Value=""
Range("A" & i).Delete Shift:=xlUp
End If
If Range("B" & i).Value=""
Range("B" & i).Delete Shift:=xlUp
End If
Next
You can change the range according to your sheet. Also, modify the code to use another 'IF' condition to check blanks, if that works better for your case.
I have two headers in two rows in my excel based on which i upload values for each row. if the combination of two headers is already available, the values will be updated in that row. If that combination is not available a new column will be created.
Sample Excel
As in the image, If i find Column 2 and Column B combination again i can update value in a new row against Column 2 and Column B. If there is another combination of headers say, Column 5 and column B, then it will create a new column.
Using VBA i am able to check only one column header but not the combination of the headers. i used the below code.
Set c=ws.Range("B2",ws.Cells(2,Columns.Count)).Find:=What(d,1)
IF c is Nothing Then
My code
Else`My Code End If
Find can't be used to find values spread over several cells. I suggest this kind of code.
Private Sub FindMatchingColumn()
' 24 May 2017
Dim Caption1, Caption2
Dim Combination As String
Dim Captions As String
Dim C As Long
Caption1 = "Column A"
Caption2 = "Column 1"
Combination = CStr(Caption1) & CStr(Caption2)
With ActiveSheet
Do
C = C + 1
Captions = CStr(.Cells(1, C).value) & CStr(.Cells(2, C).value)
If StrComp(Captions, Combination, vbTextCompare) = 0 Then Exit Do
Loop While Len(Captions)
If Len(Captions) Then
MsgBox "Column " & C & " has matching captions"
Else
MsgBox "No matching captions were found" & vbCr & _
"Write new captions to Column " & C
.Cells(1, C).value = Caption1
.Cells(2, C).value = Caption2
End If
End With
End Sub
Caption1 and Caption2 are the two column headers you are looking for. The first part of the code loops through all the columns to find that combination. If it is found it passes the column where it was found to the following code. If not, it passes the number of the next blank column.
The second part takes that column number and acts upon it. If it is a used column you can add your value there. If it is a new column it adds the two captions and then you can add your values in it.
This code presumes that you know the sequence of the captions. If you need to accept either A + B or B + A both values must be checked before passing to the next column in the Do loop.
I have 2 different files which have different headers, for example:
OldfileHeaders | NewFileheaders
ID | Test ID
Date | New date
and so on. I am trying to compare the data in both sheets and see if they match. The rows of data may be in different order and the headers may also be in different order.
So what I am trying to do is:
1) define which headers match which headers between the 2 files
2) find the ID from the oldfile and see if it is in the new file, if it is then see if the data under each header matches. If it doesn't then export that row of data to a new sheet add a column and label it "Missing".
The Code So far:
Set testIdData = testIdData.Resize(testIdData.CurrentRegion.Rows.Count)
Do Until sourceId.Value = ""
datacopy = False
' Look for ID in test data
Set cellFound = testIdData.Find(What:=sourceId.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If cellFound Is Nothing Then
' This entry not found, so copy to output
datacopy = True
outputRange.Resize(ColumnSize:=NUMCOLUMNS).Interior.Color = vbRed
Else
' This assumes that columns are in same order
For columnNum = 2 To NUM_COLUMNS_DATA
' No need to test the ID column
If sourceId.Cells(ColumnIndex:=columnNum).Value <> cellFound.Cells(ColumnIndex:=columnNum).Value Then
outputRange.Cells(ColumnIndex:=columnNum).Interior.Color = vbYellow
datacopy = True
End If
Next columnNum
End If
If datacopy Then
sourceId.Resize(ColumnSize:=NUMCOLUMNS).Copy
outputRange.PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Set outputRange = outputRange.Offset(RowOffset:=1)
difference = difference + 1
End If
Set sourceId = sourceId.Offset(RowOffset:=1)
Loop
This code works depending on me formatting the sheets in the correct order and changing the header names.
I need help in defining which field names match which field names within the 2 sheets, and then searching the new sheet for each ID and seeing if the data in the corresponding cells match. If the ID is not in the sheet then output that row too a different sheet. If the id is present and there are differences in the cells then out put these to the shame sheet. I want to produce a tally of differences in each column.
Matching up data between data sets requires that you give the program some help. In this case, the help needed is which columns are related to each other. You have identified a small table of how headers are related. With this, you can do the various translations from data source 1 to data source 2. It requires heavy usage of Application.Match and Application.VLookup.
I will provide a base example which does the core of what you are trying to do. It is much easier to see it all on one sheet which is what I have done.
Picture of data shows three tables: rng_headers, rng_source, and rng_dest. One is the lookup for the headers, the second is the "source" data, and the third is the data source to compare against which I will call destination = "dest".
Code include steps to: iterate through all the IDs in the source data, check if they exist in the dest data, and, if so, check all the individual values for equality. This code checks the headers on every step (which is slow) but allows for the data to be out of order.
Sub ConfirmHeadersAndMatch()
Dim rng_headers As Range
Set rng_headers = Range("B3").CurrentRegion
Dim rng_dest As Range
Set rng_dest = Range("I2").CurrentRegion
Dim rng_source As Range
Set rng_source = Range("E2").CurrentRegion
Dim rng_id As Range 'first column, below header row
For Each rng_id In Intersect(rng_source.Columns(1).Offset(1), rng_source)
Dim str_header As Variant
str_header = Application.VLookup( _
Intersect(rng_id.EntireColumn, rng_source.Rows(1)), _
rng_headers, 2, False)
'get col number
Dim int_col_id As Integer
int_col_id = Application.Match(str_header, rng_dest.Rows(1), 0)
'find ID in the new column
Dim int_row_id As Variant
int_row_id = Application.Match(rng_id, rng_dest.Columns(int_col_id), 0)
If IsError(int_row_id) Then
'ID missing... do something
rng_id.Interior.Color = 255
Else
Dim rng_check As Range 'all values, same row
For Each rng_check In Intersect(rng_source, rng_id.EntireRow)
'get col number
str_header = Application.VLookup( _
Intersect(rng_check.EntireColumn, rng_source.Rows(1)), _
rng_headers, 2, False)
int_col_id = Application.Match(str_header, rng_dest.Rows(1), 0)
'check value
If rng_check.Value <> rng_dest.Cells(int_row_id, int_col_id).Value Then
'values did not match... do something
rng_dest.Cells(int_row_id, int_col_id).Interior.Color = 255
End If
Next rng_check
End If
Next
End Sub
Notes on the code
Ranges are built on CurrentRegion which picks out the blocks of data. You can swap these out for different ranges on different sheets.
Column header translation is done with Application.VLookup to check the source header and return the destination header. This String is then found in the destination header row using Application.Match. You could abstract this code into a Function to avoid repeating it twice.
Once the column is found, the ID is searched for in the destination table using Application.Match. This will return an error if the ID is not found.
If the ID is found, it then checks all of the other values in the same row, comparing them against the correct columns in the destination table. Non-matching results are colored red.
If all of the columns do not have pairs, you can add additional checks on the VLookup or the column Match to check this.
The vast majority of this code just handles getting to the correct spots in the data using Intersect, Rows, and Columns.
Results show some red values for the ID not found and the values that don't match.
I have multiple spreadsheets that each roughly look like this:
I'm trying to find a way to go through each of the SPEAKER HEADERS in Row 1, and summarize the scores that are associated with the corresponding survey question ("Was the CONTENT good? Was the SPEAKER relevant? What the DELIVERY good?) grouped by color.
I can't think of a clever way of doing this automatically.
I can get the RANGE SPANS of the Merged Cells like this:
For Each Cell In src_sheet.UsedRange.Cells
If Cell.Row = 1 And IsEmpty(Cell) = False Then
MsgBox Cell.MergeArea.Address
End If
Next
I then need to iterate over the range provided by the address, getting the numerical values in all the rows BELOW that range.
For example, running the current macro produces this:
I need to take $C$1:$E$1 and run a for loop that say FROM C1 to E1 average all the numbers in the rows below it. I have no idea how to do this.
I was thinking about augmenting the selection in include everything used
Is there a better way to do this?
This is the tragically bad way I'm doing it now (which I'm quite proud of on account of being new to excel):
For Each Cell In src_sheet.UsedRange.Cells
If Cell.Row = 1 And IsEmpty(Cell) = False Then
Set rng = Range(Cell.MergeArea.Address) 'Equal to the Address of the Merged Area
startLetter = Mid(rng.Address, 2, 1) 'Gets letter from MergeArea Address
endLetter = Mid(rng.Address, 7, 1) 'Gets letter from MergeArea Address
On Error GoTo ErrHandler:
Set superRange = Range(startLetter & ":" & endLetter)
ErrHandler:
endLetter = startLetter
Set superRange = Range(startLetter & ":" & endLetter)
Resume Next
superRange.Select
MsgBox Application.Average(Selection)
In order to get rid of the error you are having, you need to change:
Set rng = Cell.MergeArea.Address
to
Set rng = Range(Cell.MergeArea.Address)
Ideally, this data would be better stored in a database so that it could be queried easily. If that's not an option, then the way you are going at it in Excel is as valid as most any other approach.
EDIT
Once you obtain the address of the left-most column for each of your speakers, you can loop through each column to obtain averages.
'Number of columns in the current speaker's range.
numColumns = rng.Columns.Count
'First row containing data.
currentRow = 4
'First column containing data.
firstColumn = rng.Column
'Loop through each column.
For col = firstColumn to firstColumn + (numColumns -1)
totalValue = 0
'Loop through each row.
Do While Cells(currentRow,col).value <> ""
totalValue = totalValue + Cells(currentRow,col).Value
currentRow = currentRow + 1
Loop
averageValue = totalValue / (currentRow - 3)
'Reset the currentRow value to the top of the data area.
currentRow = 4
'Do something with this average value before moving on to the next column.
Next
If you don't know what row is the start of your data, you can keep checking every row below rng.Row until you hit a numeric value.
The method above assumes that you have no blank entries in your data area. If you have blank entries, then you should either sort the data prior to running this code, or you would need to know how many rows you must check for data values.