Merge cells of tables in the header in Word VBA - vba

I would like to merge two cells of the second table in the header of my Word document. I created the script below but it has a run-time error: '5491'.The requested member of the collection does not exist.
The error occured on this line" With xTable(2)"
Sub mergercells()
Set xTable = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables
With xTable(2)
.Cell(Row:=3, Column:=2).Merge _
MergeTo:=.Cell(Row:=3, Column:=1)
.Borders.Enable = False
End With
End Sub
Thanks,

All you need is:
Sub MergeCells()
With ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(2)
.Cell(Row:=3, Column:=2).Merge MergeTo:=.Cell(Row:=3, Column:=1)
.Borders.Enable = False
End With
End Sub

Related

VBA_Processing a value as 29160012040000TZ

I created a couple of user forms which operate a data in separate report workbook. My script can successfully proceed a value in digit type. Unfortunately the circumstances have changed and now it has to work with a Serial Numbers as: 29160012040000TZ. With that new value script after starting the Sub, open a report, but it never enter into a 'with' statement. It doesn't look for a value or doing something else. Just open a report workbook and freeze.
Below you can see the code lines where issue is present and a little description:
Single_PHA is a text window in User Form where user can enter a a value, proceeding value is 29160012040000TZ
Private Sub Wydaj_button_Click()
Workbooks.Open Filename:="N:\ENGINEERING\1. ENGINEERS\Mateusz Skorupka\PHA_Cleaning_report_path\PHA_CLEANING_REPORT.xlsm", ReadOnly:=False
Dim REPORT As Workbook
Set REPORT = Application.Workbooks("PHA_CLEANING_REPORT.xlsm")
Set TABLE = REPORT.Worksheets("Main_table")
...
With TABLE.Range("A1")
If Single_PHA = True Then
If Not IsError(Application.Match(Single_PHA.Value, .Range("A:A"), 0)) Then
Single_PHA_row = TABLE.Range("A:A").Find(What:=Single_PHA.Value, LookIn:=xlValues).Row
.Offset(Single_PHA_row - 1, 4).Value = Date
REPORT.Close SaveChanges:=True
Single_PHA.Value = ""
Exit Sub
Else
MsgBox "Numer seryjny głowicy nie istnieje w bazie"
REPORT.Close SaveChanges:=False
Exit Sub
End If
End If
End With
In VBA I don't know how to open something like debugger or make the print instruction which would show me how the variables look on specific steps.
I am not sure if VBA read the value as 29160012040000TZ as string. I tried to declare at the beginning a variable as Single_PHA_STR as String and the proceed it as just text, but no wins there:
Dim Single_PHA_STR As String
...
With TABLE.Range("A1")
If Single_PHA = True Then
Single_PHA_STR = Str(Single_PHA.Value)
If Not IsError(Application.Match(Single_PHA_STR, .Range("A:A"), 0)) Then
Single_PHA_row = TABLE.Range("A:A").Find(What:=Single_PHA_STR, LookIn:=xlValues).Row
.Offset(Single_PHA_row - 1, 4).Value = Date
REPORT.Close SaveChanges:=True
Single_PHA.Value = ""
Exit Sub
Else
MsgBox "Numer seryjny głowicy nie istnieje w bazie"
REPORT.Close SaveChanges:=False
Exit Sub
End If
End If
End With
I noticed that if in VBA IDE I write a bold value 29160012040000TZ, I get an error
Expected line number or label or statement or end of statement
and the value is highlighted in red.
Could someone help me in that field and explain the nature of issues:
To reproduce a situation you can create a simply user form with one TextBox and one CommandButton. In the same worksheet as user form in a column A put a values: 29160012040000 and 29160012042027IR
Then make a sub which execute after double click on command button with code:
Private Sub CommandButton1_Click()
With Worksheets("Sheet1").Range("A1")
If Text_box1 = True Then
If Not IsError(Application.Match(Text_box1.Value, .Range("A:A"), 0)) Then
Text_box1_row = Worksheets("Sheet1").Range("A:A").Find(What:=Text_box1.Value, LookIn:=xlValues).Row
.Offset(Text_box1_row - 1, 4).Value = Date
Text_box1.Value = ""
Exit Sub
Else
MsgBox "PHA SN not exist in a database"
Exit Sub
End If
End If
End With
End Sub
Then try to input in a UserForm's TextBox a value = 29160012040000 and you will see that script successfully filled a forth column in row with current date. Then try to input a value 29160012042027IR and you will see that nothing happened. Script don't proceed that value at all.
So that is my issue and question indeed. How to process a value with letters at the end like: 29160012042027IR : )
I also tried to focus a script statement on one specific cell in which is a text value "29160012042027IR" that which I input into a UserForm TextBox. Looking with a debugger both of variables in if statement have the same text value, but still script miss that statement and go to else instructions : (
I mean abut: If Range("A3").Text = Text_box1.Text Then
When I change a statement for "If Range("A3").Value = Text_box1.Value Then" the same thing happen.
Private Sub CommandButton1_Click()
With Worksheets("Sheet1").Range("A:A")
If Text_box1 = True Then
If Range("A3").Text = Text_box1.Text Then
Text_box1_row = Worksheets("Arkusz1").Range("A:A").Find(What:=Text_box1.Value, LookIn:=xlWhole).Row
.Offset(Text_box1_row - 1, 4).Value = Date
Text_box1.Value = ""
Exit Sub
Else
MsgBox "PHA SN not exist in a database"
Exit Sub
End If
Else
MsgBox "Other loop"
End If
End With
End Sub
IMPORTANT NOTICE:
I found the main issue. I made wrong if condition, it should be:
If Single_PHA <> "" Then previously I have got: If Single_PHA = True Then, and there the results is a value not the boolean type.
Everything works. Thank everyone very much for help.
Topic is ready to be closed.
PS: thank you Tom for suggestion and tip with debugger: )

Macro to Count Rows in One Table and Add that # Rows in Second Table

I have a word document with a number of tables.
I'm trying to build a Macro to count the number of rows in Table1, store that number as Variable: [n_rows], then insert [n_rows] into Table7.
I'm working with bookmarks in case users add new tables, but I'm open to the idea of just using ActiveDocument Tables or whatever.
I'm getting "invalid or unqualified reference" on my .Variables line of my code (see below).
Help!
Sub CountRows()
'
' CountRows
'
'
If ActiveDocument.Bookmarks.Exists("Objectives") = True Then
ActiveDocument.Bookmarks.Item("Objectives").Select
.Variables("numrows").Value = Selection.Tables(1).Rows.Count
End If
Selection.GoTo What:=wdGoToBookmark, Name:="LogFrameSO"
Selection.InsertRowsBelow [NumRows]
End Sub
If you were to be using code like:
.Variables("numrows").Value
a Document variable named 'numrows' would have to exist; and
with your existing code, you would need to reference it as ActiveDocument.Variables("numrows").Value in both instances.
Try:
Sub AddRows()
Application.ScreenUpdating = False
Dim r As Long, i As Long
With ActiveDocument
If .Bookmarks.Exists("Objectives") Then
r = .Bookmarks("Objectives").Range.Tables(1).Rows.Count
End If
If .Bookmarks.Exists("LogFrameSO") Then
With .Bookmarks("LogFrameSO").Range.Tables(1).Rows
For i = 1 To r
.Add
Next
End With
End If
End With
Application.ScreenUpdating = True
End Sub

Excel Userform VBA VLOOKUP

I am creating a userform where based on a drop down list of items called "ContractsList" I would like a Vlookup formula to return a text data in "TextBox 1".
I get an error message saying "Run-time error'1004': Unable to get the Vlookup property of the worksheetfunction class
Not sure what I am doing wrong, here is my code if anyone can spot the error.
Private Sub ContractsList_AfterUpdate()
If WorksheetFunction.CountIf(Sheet2.Range("A:A"),Me.ContractsList.Value) = 0 Then
MsgBox "This contract is not on the list"
Me.ContractsList.Value = ""
Exit Sub
End If
'Lookup values based on first control
With Me
.TextBox1 = Application.WorksheetFunction.VLookup(Me.TextBox1, ("B5:B72"), 2, 0)
End With
End Sub
Finally got it to work as below:
Private Sub ContractsList_AfterUpdate()
If WorksheetFunction.CountIf(Sheet2.Range("A:A"), Me.ContractsList.Value) = 0 Then
MsgBox "This contract is not on the list"
Me.ContractsList.Value = ""
Exit Sub
End If
'Lookup values based on first control
With Me
.TextBox1 = Application.WorksheetFunction.VLookup(Me.ContractsList, Sheet2.Range("A5:E72"), 2, 0)
End With
End Sub
I just needed to add "Sheet2.Range("A5:E75")
Thank you all for your help.

Sub or function not defined: Buttons()

I had this sub in another spreadsheet where I could click a button to collapse and expand certain columns. I copied it into a new spreadsheet to use to collapse some rows but now I get the error "Sub or function not defined". It highlights Buttons
Sub HideDetails()
Range("3:8").Select
If Selection.EntireColumn.Hidden Then
Selection.EntireColumn.Hidden = False
Buttons("btnToggleDetails").Caption = "-"
Else
Selection.EntireColumn.Hidden = True
Buttons("btnToggleDetails").Caption = "+"
Range("A1").Select
Application.CutCopyMode = False
End If
Range("A1").Select
Application.CutCopyMode = False
End Sub
There are no other scripts in this workbook. This one was originally in Module1 but I tried moving it to a new module.
Edit: I changed the button name in the code but not the screenshot. Both references are to btnToggleDetails now but it still throws the same error.
It's telling you that the identifier Buttons() can't be found in the current scope. If Buttons() is something that you've declared somewhere else, you either need to make it public or you need to fully qualify the object that contains the Buttons() object, for example:
Sheet1.Buttons("btnToggleDetails").Caption = "+"
Had to add my answer as was sure I could shorten the lines of code:
If you consider that Selection.EntireColumn.Hidden returns TRUE/FALSE or 0/-1.
CHR(45) is a minus sign.
CHR(43) is a plus sign.
ABS turns -1 into 1.
So:
If TRUE (0) then 45-(0*2) = 45
If FALSE (-1) then 45-(1*2) = 43
This will swap the columns from hidden to visible and vice-versa and display the correct button caption in the immediate window:
Sub HideShowColumns()
Selection.EntireColumn.Hidden = Not (Selection.EntireColumn.Hidden)
Debug.Print Chr(45 - (Abs(CLng(Selection.EntireColumn.Hidden)) * 2))
End Sub
This should work in your procedure:
Sub HideDetails()
Dim rng As Range
Set rng = ActiveSheet.Range("3:8")
rng.EntireColumn.Hidden = Not (rng.EntireColumn.Hidden)
Buttons("btnToggleDetails").Caption = Chr(45 - (Abs(CLng(rng.EntireColumn.Hidden)) * 2))
End Sub

CircleInvalid and ClearCircle methods for a particular cell in excel vba 2007

I am using data validation in excel 2007. I am using this code to make invalid data marked with red circle.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rc As Integer
Range(Target.Address).Select
ActiveSheet.ClearCircles
ActiveSheet.CircleInvalid
If Not Range(Target.Address).Validation.Value Then
rc = MsgBox("Data Validation errors exist! " & Range
(Target.Address).Validation.ErrorMessage & " Please correct circled entries!", vbCritical, "Failure")
Exit Sub
End If
End Sub
As you can see in the code when I put wrong data then first of that specific range is going to selected and then all invalid data is marked with red circle.
But I want that only that specific cell should be marked with red not all data .
Thanks.
You can try this code from an Excel MVP:
Dim TheCircledCell As Range
Sub CircleCells(CellToCircle As Range)
If Not CellToCircle Is Nothing Then
With CellToCircle
If .Count > 1 Then Exit Sub
Set TheCircledCell = CellToCircle
.Validation.Delete
.Validation.Add xlValidateTextLength, xlValidAlertInformation, xlEqual, 2147483647#
.Validation.IgnoreBlank = False
.Parent.CircleInvalid
End With
End If
End Sub
Sub ClearCircles()
If Not TheCircledCell Is Nothing Then
With TheCircledCell
.Validation.Delete
.Parent.ClearCircles
End With
End If
End Sub
Note that you can't use the Excel standard Validation function on these cells.
[Source and explanation of the code]