Private Sub CommandButton1_Click()
Dim tl As Integer
t1 = 33
'**************
Dim tbl1 As Table
Dim rng As Range
Set doc = ActiveDocument
Set tbl1 = ActiveDocument.Tables(t1)
Set rng = doc.Range(Start:=tbl1.Cell(2, 5).Range.Start, _
End:=tbl1.Cell(100, 5).Range.End)
rng.Text = TextBox1.Text
When I press the button, this code does not work properly, I can fill only Start:=tbl1.Cell(2, 5).... This fills only 1 cell
But End:=tbl1.Cell(100, 5).Range.End) doesn't work. It does not fill all the rows.
You need to loop through all of the cells concerned. For example:
Private Sub CommandButton1_Click()
Dim tl As Long, r As Long
t1 = 33
With ActiveDocument.Tables(t1)
For r = 2 To 100
.Cell(r, 5).Range.Text = TextBox1.Text
Next
End With
End Sub
If you want to use the same technique that you discovered for copy one cell to multiple cells, that should also work. It's a bit tricky, though, and you don't give us enough information to reproduce the TextBox, so you may need to tweak the following.
I put the ActiveX text box on the document surface and pick it up using the InlineShapes collection. If you're using a UserForm you'll need to change that part.
It's not possible to assign a Column in Word to a Range object. A Range must be a contiguous flow of text. In Word, the contiguous flow is horizontal, then vertical - so Rows can be assigned to a Range, but not a column. (And that is why the other Answer loops the cells in the column, which is comparatively slow.)
It is possible, however, to select a column and work with the Selection. So the code below copies the content of the text box to the clipboard, then selects the entire column and pastes to the Selection.
Sub CopyToMultipleCells()
Dim tl As Integer
Dim doc As word.Document
Dim tb As MSForms.TextBox
tl = 1
'**************
Dim tbl1 As Table
Dim rng As Range
Set doc = ActiveDocument
'Change if on a UserForm
Set tb = doc.InlineShapes(1).OleFormat.Object
'Select the text box content, then copy it
tb.SelStart = 0
tb.SelLength = tb.TextLength
tb.Copy
Set tbl1 = ActiveDocument.Tables(tl)
tbl1.Columns(5).Select
Selection.Paste
End Sub
Related
I am a new VBA user, and wanting to copy data from a table in Word into Excel.
With support of lovely online folk, I have managed to get the following which seems to work:
Sub extractData()
Dim wd As New Word.Application
Dim doc As Word.Document
Dim sh As Worksheet
Dim Tbls As Word.Tables, r As Variant, cell As Variant
wd.Visible = True
Set doc = wd.Documents.Open("\\file.docx", ReadOnly:=True)
Set Tbls = doc.Tables
Set sh = ActiveSheet
For Each r In Tbls(1).Rows
For Each cell In r.Cells
sh.Cells(cell.Row.Index, cell.Column.Index).Value = Application.WorksheetFunction.Clean(cell.Range.Text)
Next cell
Next r
End Sub
However, the table in Word has horizontal cell merging, and VBA can't work with mixed cell widths. I do not need these rows to be copied, so is there a way to count how many columns (should be 6), and if less than 6 to then skip the row?
I have tried looking online, but cannot find how to get it to count the cells in each row, and then skip if less than 6. I feel like it should be pretty straightforward, but I'm very new to this!
Any suggestions?
Thanks!
a) I am surprised that you state that "VBA can't work with mixed cell widths" - I did a test and your code should work without issues on tables where you have (horizontally) merged cells. There is a problem with the code when you have vertically merged cells because in that case you cannot access the individual rows of the table
b) if you want to loop over all cells of a table no matter if it has merged cells or not, you can loop over all cells of the Range of the table:
Dim rng As Word.Range
Dim tbl As Word.Table
Set tbl = doc.Tables(1)
Set rng = tbl.Range
For Each cell In rng.Cells
Debug.Print cell.RowIndex, cell.ColumnIndex, cell.Range.Text
Next
The properties RowIndex and ColumnIndex give you the row resp. column number of the cell - if it is a merged cell, it's the first (top left) cell.
c) To get the number of cells in a row or column, you can use the cells.Count property. As mentioned, this will work for rows only if there are no vertically merged cells, similarly, it will for columns only if there are no horizontally merged cells.
Dim row As Word.row, col As Word.Column
For Each r In tbl.Rows
r.Cells.Count
Next r
Dim c As Word.Column
For Each c In Tbls(1).Columns
c.Cells.Count
Next
A row has a collection of cells, and collections always have a Count property.
Sub extractData()
Dim wd As New Word.Application
Dim doc As Word.Document
Dim sh As Worksheet
Dim Tbls As Word.Tables, r As Word.Row, cell As Word.Cell
wd.Visible = True
Set doc = wd.Documents.Open("\\file.docx", ReadOnly:=True)
Set Tbls = doc.Tables
Set sh = ActiveSheet
For Each r In Tbls(1).Rows
If r.Cells.Count = 6 Then
For Each cell In r.Cells
sh.Cells(cell.Row.Index, cell.Column.Index).Value = Application.WorksheetFunction.Clean(cell.Range.Text)
Next cell
End if
Next r
End Sub
I work heavily with PivotCharts, but have absolutely zero VBA experience. I have excel templates that are uploaded to a database, then can be downloaded as a report with the data from that database. I have a pivotTable/PivotChart combo on one sheet. Sometimes the table has 5 rows of data, and sometimes is has 1200 rows of data, depending on the database, timeframe, etc.
What I'd like to do, is have the chart take up the same number of rows as the table + 3 in height, and always display in D3:J3 for width and starting position. This aligns the data with the charts.
I have found a similar ? from last year here: Resize pivot chart when selecting different less/more values
It has not gotten me any results (or I'm doing something wrong).
Relevant info: table/chart is on Sheet4 ("Summary"), and under PivotTable Options, it is called "IdleSummary".
I appreciate any help that can be given, thanks!
One way to do it, is to use a range object to size your chart like so:
Sub test()
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Summary")
Dim vPiv As PivotTable
Dim vRowCount As Long
Dim graphSizer As Range
Dim theChart As ChartObject
Set vPiv = ws.PivotTables("IdleSummary")
vRowCount = ws.Range(vPiv.TableRange2.Address).Rows.Count + 3
Set graphSizer = ws.Range("D3:J" & vRowCount)
Set theChart = ws.ChartObjects.Add(Left:=graphSizer.Left, Top:=graphSizer.Top, Width:=graphSizer.Width, Height:=graphSizer.Height)
With theChart.Chart
.SetSourceData vPiv.TableRange2
.ChartType = xlArea 'replace with desired chartType
End With
End Sub
EDIT, to answer comments:
Modifying the above code, and using the worksheet PivotTableUpdate event you could do like so:
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
If Target.Name = "IdleSummary" Then
Call Resize
End If
End Sub
Sub Resize()
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Summary")
Dim vPiv As PivotTable
Dim vRowCount As Long
Dim graphSizer As Range
Dim theChart As ChartObject
Dim charObj As ChartObject
Set vPiv = ws.PivotTables("IdleSummary")
vRowCount = ws.Range(vPiv.TableRange2.Address).Rows.Count + 3
Set graphSizer = ws.Range("D3:J" & vRowCount)
Set theChart = ws.ChartObjects(1)
With theChart.Chart.Parent
.Left = graphSizer.Left
.Top = graphSizer.Top
.Width = graphSizer.Width
.Height = graphSizer.Height
End With
End Sub
This is assuming you have just one chart, else you can replace the index (1) with the chart name, e.g. ("Chart 1"). If you interested in reading about events you can find an introduction here: http://www.cpearson.com/excel/Events.aspx
I have a very complex workbook with many tabs. The tabs may have either normal data or formulas in various cells. In the case of formulas, the formulas may be nested from one sheet to the next (i.e. a formula on sheet1 refers to a formula on sheet2 which in turn refers to a formula on sheet3, etc.).
I have a hidden tab that contains the following: source sheet, source range, target sheet, and target range.
A named range has been created over these 4 fields and all applicable rows.
When we wish to save data to the database, we loop through every row in the range mapping and copy the data from the source sheet/range to the target sheet/range. After this, the applicable data is serialized into XML and sent to a web service to be saved.
The problem that we wish to resolve is that we want to mark a cell on a hidden sheet when a change is made by the user to a source range. Since formulas can be nested, the Worksheet_Change event does not pick up the change.
Since a change on one sheet may affect another sheet that is not the active sheet, the Workbook_SheetChange event does not catch the change either.
Is there any way form me to catch when a sheet defined in the mapping is changed, even if it is the result of a formula change several levels deep?
Edit
Thank you for your responses. I was attempting to find the fastest and least process intensive way to determine if data changes within a monitored range. The data may consist of actual data or of nested formulas.
My research showed that I could not actually achieve this result by taking range intersections as I could not detect if the data within a monitored range was modified. This is due to the fact that the monitored range may not be on the active sheet and also may contain formulas.
I have shown the method used to actually detect a change below. If there is any feedback on a better way to achieve the same result, I would appreciated it.
Worksheet_Change event will not work if a cell value is changed by a formula, you need Worksheet_Calculate.
Check out my example workbook here.
And Here for the WebPage of example codes
There is no "easy" way to detect if a nested formula has changed when the formula being monitored is not on the active sheet. While my hope was to detect the modified range and use an intersection of ranges to set a flag, this was not possible because the Worksheet_Change event does not work on formulas and the Workbook_SheetChange event only works on the active sheet. Since my workbooks have over 20+ tabs and 20 - 30 ranges being monitored, this approach does not work. This approach was desired for speed purposes.
Instead, the workbook will need to "check" to see if the current values are the same as the last time the save to database event was called. If not, a dirty flag will be set.
The code for this approach is provided below.
An example of the mapping range is shown in the picture below though in practice there are 20-30 rows comprising this range.
There are three other sheets where Sheet3 contains actual data in A1:H1 and Sheet2 has formulas pointing to Sheet3. Sheet1 has formulas pointing to Sheet2.
As the mapping range indicates, we are looking at a range on Sheet1, even though changes may be made to Sheet3.
The code used is as provided below.
Option Explicit
Public Sub DetermineIfEditOccurred()
Dim oMappingRange As Range
Dim szSourceTab As String
Dim szSourceRange As String
Dim oSourceRange As Range
Dim szTargetTab As String
Dim szTargetRange As String
Dim oTargetRange As Range
Dim oWorksheetSource As Worksheet
Dim oWorksheetTarget As Worksheet
Dim oRangeIntersection As Range
Dim nRowCounter As Long
Dim nCellCounter As Long
Dim szSourceValue As String
Dim szTargetValue As String
Dim oCell As Range
Dim bIsDirty As Boolean
If Range(ThisWorkbook.Names("DirtyFlag")).Value = 0 Then
Set oMappingRange = Range(ThisWorkbook.Names("Mapping"))
For nRowCounter = 1 To oMappingRange.Rows.Count
szSourceTab = oMappingRange(nRowCounter, 1)
szSourceRange = oMappingRange(nRowCounter, 2)
szTargetTab = oMappingRange(nRowCounter, 3)
szTargetRange = oMappingRange(nRowCounter, 4)
Set oWorksheetSource = ThisWorkbook.Worksheets(szSourceTab)
Set oWorksheetTarget = ThisWorkbook.Worksheets(szTargetTab)
Set oSourceRange = oWorksheetSource.Range(szSourceRange)
Set oTargetRange = oWorksheetTarget.Range(szTargetRange)
nCellCounter = 1
For Each oCell In oSourceRange.Cells
szSourceValue = oCell.Value
If szSourceValue = "#NULL!" Or _
szSourceValue = "#DIV/0!" Or _
szSourceValue = "#VALUE!" Or _
szSourceValue = "#REF!" Or _
szSourceValue = "#NAME?" Or _
szSourceValue = "#NUM!" Or _
szSourceValue = "#N/A" Then
szSourceValue = ""
End If
szTargetValue = GetCellValueByPosition(oTargetRange, nCellCounter)
If szSourceValue <> szTargetValue Then
Range(ThisWorkbook.Names("DirtyFlag")).Value = 1
bIsDirty = True
Exit For
End If
nCellCounter = nCellCounter + 1
Next
If bIsDirty Then
Exit For
End If
Next
End If
End Sub
Public Function GetCellValueByPosition(oRange As Range, nPosition As Long) As String
Dim oCell As Range
Dim nCounter As Long
Dim szValue As String
nCounter = 1
For Each oCell In oRange
If nCounter = nPosition Then
szValue = oCell.Value
Exit For
End If
nCounter = nCounter + 1
Next
GetCellValueByPosition = szValue
End Function
The Workbook_SheetChange event is as follows:
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call DetermineIfEditOccurred
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name <> "MAPPING" Then
Call DetermineIfEditOccurred
End If
End Sub
I'm using microsoft excel 2013.
So i have two sheets. "Cases" and "Summarize". All of my important info is on the Cases sheet. Is there way i can be on the "Summarize" sheet, push a button and copy all the cellrows with the value "RLH" from cases over to the summarize sheet?
I've filled the entire row up to N. And i want that entire row to be copied into the summarize sheet when I push the button. The "RLH" value is on the N(last) column.
I know how to create the button and how to insert the code. I've been googling my ass of, but I cant seem to find anything that fits me.
All help is greatly appreciated.
Here is very simple. that will get you started
assign to Button
Option Explicit
Sub Mybutton()
'// declare a variable
Dim cRng As Range
Dim rngA As Long
Dim rngB As Long
Dim Cols As Long
Dim sCases As Worksheet
Dim sSummarize As Worksheet
'// Set the sheets name
Set sCases = Sheets("Cases")
Set sSummarize = Sheets("Summarize")
'// goes through each cell in Sheets"Cases"
'// and copes the Value "RLH" to Sheets"Summarize"
'// it starts from last row in column A & looks up
rngA = sCases.Cells(Rows.Count, "N").End(xlUp).Row
Cols = sCases.UsedRange.Columns.Count
For Each cRng In sCases.Range("A2:A" & rngA)
If cRng.Value = "RLH" Then '<<<<<<<<< Value = "RLT"
rngB = sSummarize.Cells(Rows.Count, "A").End(xlUp).Row + 1
sSummarize.Range("A" & rngB).Resize(1, Cols) = cRng.Resize(1, Cols).Value
End If
'// loop
Next cRng
Set sSummarize = Nothing
Set sCases = Nothing
End Sub
hope this helps
you may also find help full on the following link MSDN Getting Started with VBA.
I have sheet names in cells C2 to C5, which are dynamic. I would like to select them at the same time using VBA.
The only way I have found uses arrays and "hard-coding" the sheet names.
Sub ssheets()
Worksheets(Array("Sheet2", "Sheet3","Sheet4","Sheet5")).Select
End Sub
I would like something that uses Range("C2:C5") so that I can select the relevant sheets without having to type in "Sheet2", "Sheet3","Sheet4","Sheet5" etc.
The sheet names array has to be of type Variant containing a one dimensional array. The Range("C2:C5") returns a two dimensional array. To use this as sheet names array, you have to transpose it.
Sub ssheets()
Dim oWS As Worksheet
Dim aSheetnames As Variant
Set oWS = Worksheets(1)
aSheetnames = oWS.Range("C2:C5")
aSheetnames = Application.WorksheetFunction.Transpose(aSheetnames)
Worksheets(aSheetnames).Select
End Sub
Try this:
Sub Macro1()
Dim sheetArray() As String
Dim i As Integer
i = 0
For Each c In Range("C2:C5").Cells
ReDim Preserve sheetArray(0 To i)
sheetArray(i) = c.Value
i = i + 1
Next
Sheets(sheetArray).Select
End Sub
You may also consider adding verification if the sheet with that name exists before adding it to array.
3 lines of code needed (2, if you want ActiveSheet selected as well):
Sub sSheets()
Set xRange = Range("C2:C5") 'define ur range
Sheets(xRange.Cells(1).Value).Select 'this is only needed to de-select the ActiveSheet
For Each xCell In xRange: Sheets(xCell.Value).Select False: Next '[False] is like holding Ctrl and clicking on different tabs
End Sub