I am working on a macro to format and extract information from a number of word documents that all have 1 table in it. The problem is that this table has many rows, and each each row has either 1, 2, or 3 columns in it, and I need to ensure that the right edge of the table is always the same width.
The actual behaviour that I want to replicate in VBA code is when you drag the little square thing on the ruler bar in word (that represents the right edge of the table) to adjust the right edge of the table for all rows. However, when I try and record a macro, it generates the following line of code, which does not work for tables with merged columns:
Selection.Tables(1).Columns(1).SetWidth ColumnWidth:=501.3, RulerStyle:= _
wdAdjustNone
Next I tried to explicitly target just the first row using the following code. This worked, but it only resized the width for the first row - all of the other rows were unchanged:
wdApp.Documents(myDoc).Tables(1).Cell(1, 1).SetWidth ColumnWidth:=501.3, RulerStyle:=_
wdAdjustNone
I then played around with the .width property, rather than the .setwdith property, but they seemed to behave the same. I even tried all four .setwidth RulerStyle parameters but they all behaved the same.
Finally, in frustration, I decided to loop through all of the rows in the table, and resize the rightmost column as needed so the entire row is my desired 501.3 pixels. This took some doing, as I could not find a way to tell how many columns are on a given row. I ended up relying on trapped errors to solve the issue - see below. The 4th row will error when there are not enough columns on that row, so I simply reduce the i variable and try again until there is no error:
On Error GoTo BadExit
For row = 1 To wdApp.Documents(myDoc).Tables(1).Rows.count
i = 3
If wdApp.Documents(myDoc).Tables(1).Cell(row, i).PreferredWidth <> 1501.3 Then
If i = 3 Then
wid = 501.3 - wdApp.Documents(myDoc).Tables(1).Cell(row, 2).Width - wdApp.Documents(myDoc).Tables(1).Cell(row, 1).Width
wdApp.Documents(myDoc).Tables(1).Cell(row, i).Width = wid
ElseIf i = 2 Then
wid = 501.3 - wdApp.Documents(myDoc).Tables(1).Cell(row, 1).Width
wdApp.Documents(myDoc).Tables(1).Cell(row, i).Width = wid
Else
wid = 501.3
wdApp.Documents(myDoc).Tables(1).Cell(row, i).Width = wid
End If
End If
GoTo SafeExit
BadExit:
If i = 3 Then
i = 2
Resume
ElseIf i = 2 Then
i = 1
Resume
End If
SafeExit:
Next row
This code runs through with no errors however the final width never seems to be 501.3 - it seems to vary inconsistently (which I confirmed by using msgbox with the .width property), and also, sometimes the right edges are not lined up! The rows with 1 column may stick out a bit further than the rows with 2 columns, etc. And this code is very slow.
Can anybody help me find a simple solution to replicate the behavior of manually using your mouse to move the right square on the ruler to adjust the width of every row in a word table to a specific value? Your help would be greatly appreciated.
Thanks in advance,
-Josh
Related
I am doing a simple VBA script in Microsoft Excel which iterates a list of cars and a list of information about when the cars were refueled to provide an overview of how many kilometers each car is driving each month.
I make use of the Range.End property to calculate the number of rows with data and then loop through the indicies.
Set Data = Worksheets("Tankninger") ' Danish for refuellings
NumRows = Data.Range("A1", Data.Range("A1").End(xlDown)).Rows.Count
For x = 1 To NumRows
' Process data
Next
Everything seemed to be working fine, however I found that if someone applied a filter to e.g. the sheet with refuelling data - e.g. only showing data related to car A, then NumRows would be assigned the index of the last visible row.
Example: if the refuling sheet contains 100 records and the records related car A are located on row 50-60, then NumRows would be assigned the value 60 - resulting in my script ignoring the last 40 records.
Is there a way to make the Range.End property ignore any filter applied to sheet, or will I have to change the implementation to use a while-loop instead?
I ended up replacing the for-loop with a while-loop. This allowed me to access every cell regardless of any filtering applied to the sheets.
Set Data = Worksheets("Tankninger") ' Danish for refuellings
r = 2
While Not IsEmpty(Cars.Cells(r, 1).value)
' Process data
Wend
What you can do is add the following in your code to remove filters before you find the last row with data.
'Remove all filters
Worksheets("Sheet1").Activate
On Error Resume Next
ActiveSheet.ShowAllData
I'm creating a program in Visual Basic through Microsoft Excel, where I can input all the information from an application into excel. Each row is unique and features a dropdown control that is created and placed programatically (see code below).
The problem I have come across is correctly placing the control in each cell within one of the columns.
I have read through documents on the web and seen examples on other questions but none of them seem to work for my situation. I keep having to guess-n-check the x and y values for the AddFormControl function to place the controls in a somewhat correct way.
Code:
For y = 1 To UBound(array) + 1
Set lb = Sheet1.Shapes.AddFormControl(xlDropDown, 274, 32 + (19 * y), 77, 19)
With lb
.ControlFormat.DropDownLines = 3
.ControlFormat.AddItem "Select a value", 1
.ControlFormat.AddItem "Auto", 2
.ControlFormat.AddItem "Default", 3
.ControlFormat.Value = 1
End With
Next y
I have counted the width's and height's of all the rows and columns so that I can place the controls in the correct spot but they are offset, some more than others.
The 274 x-value above is what lines up to the spot I would like it to for the x-axis on the excel sheet but is not how wide the columns prior to the spot add up to. Same goes for the y-value 77.
What would be the most efficient solution to this issue?
You can actually use Range.Top and Range.Left to place your From Controls exactly where you want them and they will be perfectly lined up with the cell in question. This is a great method for adding them in large quantities dynamically.
I am trying to compare decimal values in Excel VBA and delete rows that
match the criteria. This was my original code and it skipped over many rows.
For Each i In WSData.Range("A7", WSData.Range("A7").End(xlDown)).Cells
If i.Offset(0, 3).Value >= 98 Then
i.EntireRow.Delete
End If
Next
And the values on the spreadsheet are decimal values just with the % sign.
I tried "> 97.99" because Excel has some issues with floating point comparison but it still doesn't accurately compare.
Here is what it shows after using Selection.Value.
Percentages are decimal depicted with integers. For example 100.00% is stored as 1 and 98.01% is stored as .9801.
Therefor you need to adjust the threshold:
For Each i In WSData.Range("A7", WSData.Range("A7").End(xlDown)).Cells
If i.Offset(0, 3).Value >= .98 Then
i.EntireRow.Delete
End If
Next
The second problem is that when deleting rows it is best to iterate backwards. Otherwise it might miss some rows, because as each row is deleted it is moved up and then the next iteration skips the next row.
Change i from a range to a long and use this:
For i = WSData.Range("A7").End(xlDown).row to 7 Step -1
If WSData.Cells(i,3).Value >= .98 Then
Row(i).Delete
End If
Next
Edit: Because it appears there is a custom mask on the number format that is forcing numbers to look like percentages try this:
For i = WSData.Range("A7").End(xlDown).row to 7 Step -1
If WSData.Cells(i,3).Value >= 98 Then
Row(i).Delete
End If
Next
If this works then your main problem was that you were looking at column D. The offset is additive. So when you used .offset(0,3) it was moving three columns from column A. 1 + 3 is 4.
I have to adjust sales volumes so that
1) I do not use up my daily capacity and
2) I do not run out of window by the end of the month
I need two criteria and to run until it either hits my end date or runs out of window at the end of the month.
Dates are in column A.
I have
Sub CashCalib()
Set Window = Sheets("inventory").Range("AX124")
Set Capacity = Sheets("Inventory").Range("BU95")
Set Sales = Sheets("Inventory").Range("BV95")
Set EndDate = Sheets("inputs").Range("A1")
Do Until Sales.Offset(0, -74) = EndDate
Capacity.GoalSeek _
Goal:=0 And Window.Value > 0, _
ChangingCell:=Sales
Loop
End Sub
I get
run time error 1004 application defined or object defined error
on the do until line.
Your Sales.Offset(0, -74) is moving left too far as you do not have 74 columns to go left. If you meant to move up then do Sales.Offset(-74, 0) or change to which value you need to move up. Just remember that there is not a 0 row or column in excel like many other languages.
You were receiving a Error 1004 Object error because you were offsetting one column too many. By offsetting Column BV (the 74th column) -74 columns, you were offsetting to column 0, which doesn't exist.
Modify your Do Until line to look like this:
Do Until Sales.Offset(-94, -73) = EndDate
I am generating values in Excel 2010, initially putting them into an array, then copying them into a worksheet for use as datalabels for a logarithmix x-axis (actually calling Chart Labeller to do that, but this also happens when i manually apply through Excel). For the most part this works fine without problems. In certain instances, however, some, but not all, of the data labels do not visible show, even though the data in the worksheet is there, manually selecting the data labels shows an invisible label selected.
What I found out, and I think this may be a bug in Excel, when I go to the worksheet, and re-type in the value that is not showing up on the chart, it then shows up on the chart.
Here are my dim's for the array:
Dim chart_labeler_info_x()
Here is how I populate the array:
'Assuming we are going to do the x-axis
ReDim chart_labeler_info_x(1 To x_axis_interval_num, 1 To 3)
For k = 1 To x_axis_interval_num
'Column 1 is the new chart label value, column 2 is the y value of the new series , column 3 is the x value(equivalent to 111...)
'--------------------------------------------------------
chart_labeler_info_x(k, 1) = suf_ize(10 ^ (Log(x_axis.MinimumScale) / Log(10#) + (k - 1)))
chart_labeler_info_x(k, 2) = y_axis.MinimumScale
chart_labeler_info_x(k, 3) = 10 ^ (Log(x_axis.MinimumScale) / Log(10#) + (k - 1))
'--------------------------------------------------------
Next k
Here is how I initialize the range on the worksheet:
Set new_labeler_ws_x_axis = Sheets.Add
new_labeler_ws_x_axis.Name = Chart_for_series & "Eng_Labels_X_Axis"
new_labeler_ws_x_axis.Range("a1:c" & x_axis_interval_num).Value = chart_labeler_info_x
new_labeler_ws_x_axis.Range("a1:c" & x_axis_interval_num).Font.Name = "Arial"
new_labeler_ws_x_axis.Range("a1:c" & x_axis_interval_num).Font.Size = 7
I also create a new series attached to this range:
With ActiveChart.SeriesCollection.NewSeries
.XValues = Sheets(new_labeler_ws_x_axis.Name).Range("C1:C" & x_axis_interval_num)
.Values = Sheets(new_labeler_ws_x_axis.Name).Range("B1:B" & x_axis_interval_num)
.Name = "=""Labeller_x"""
.Border.Color = RGB(0, 0, 0)
.Format.line.Visible = True
End With
The data that is generated in the worksheet looks like this:
1m 100 0.001
10m 100 0.01
100m 100 0.1
1 100 1
10 100 10
100 100 100
1k 100 1000
Column 1 has the values that will be used as the new data labels. Column 2 is the y-value, Column 3 is the actual x-value. (I can attach the worksheet if that helps.)
Here is an image of what I am talking about:
You notice that the 1k data label that should be there, is not visible.
I can make the 1k data label appear one of two ways:
Extend the maximum value for the series, in this case to 10,000 (10k) in which case the 1k label shows.
Manually go to the worksheet, select the cell that has the 1000 value, re-enter the value 1000 and press return, the data label then shows up as 1k.
Some other interesting anomalies, when the maximum value is 100, the data label for 100 disappears also. As the maximum value is increased beyond 1000, there seems to be no problems the data labels all show themselves.
I have tried changing the number format, which general, to number, with two decimal places, no luck. Changing to text and back, no luck.
I think this is a bug, but haven't found in info, can any of the experts out there shine some light on this?
I found a solution, while somewhat of a hack, i think it underlines what the problem may actually be, and maybe someone can suggest a more elegant solution.
I added the last line of this code block:
chart_labeler_info_x(k, 1) = suf_ize(10 ^ (Log(x_axis.MinimumScale) / Log(10#) + (k - 1)))
chart_labeler_info_x(k, 2) = y_axis.MinimumScale
chart_labeler_info_x(k, 3) = 10# ^ (Log(x_axis.MinimumScale) / Log(10#) + (k - 1#))
'This line did the trick
If chart_labeler_info_x(k, 3) >= 1 Then chart_labeler_info_x(k, 3) = Round(chart_labeler_info_x(k, 3), 0)
As i said previously, we had found that manually updating the value in the cell, caused the labels to be visible. We tried applying the Round function to the value in the cell, and that worked, so i put it as a check in the code, for values of 1 and higher.
It appears that, even though the cell value shown is 1000, internally, it must not be. (I checked .value and .value2, they both reported 1000.) The bug i think lies in this happening SOMETIMES. If the maximum value of the series is increased, the 1k label appears, even though it it the same math being used to generate the values.
Maybe someone can explain why this is happening and offer a more elegant solution!
Thanks,
Russ