I'm trying to use VBA to concatenate a string inside a formula. If I only use the code below i'm not getting any errors but when i add the IFERROR together with the code I get a runtime error.
Is there any way to work around it?
text1 = "='C:\Users\JOHLA\\Desktop\Yield ark\Nyt-yield-ark\[Yield-Uge-"
text2 = ".xlsm]Scrap'!H7"
The code including string with IFERROR that gives runtime error is given below.
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim i As Integer
Dim preRange As Range
Dim path, filename1 As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set ws = ActiveWorkbook.Sheets("Sheet1")
Set preRange = ws.Range("E9:I17")
i = ws.Range("C1").Value
text1 = "=IFERROR('C:\Users\JOHLA\Desktop\Yield ark\Nyt-yield-ark\[Yield-Uge-"
text2 = ".xlsm]Scrap'!H7;0)"
With ws
For i = .Range("C1").Value To .Range("C1").Value + 4
debug.print text1 & i & text2
preRange = text1 & i & text2
Set preRange = preRange.Offset(0, 5)
Next i
End With
End Sub
Judging by your use of semicolon in your formula, it would suggest that you're using local settings which are not compatible with VBA.Formula
in this case, you either need to change the formula to use a comma or set the formula using FormulaLocal:
preRange.FormulaLocal = Replace(text1 & i & text2, "'", Chr(34))
As you can see, I've also added a Replace that changes ' into " - as I think you need this also.
Lastly, don't forget to enable ScreenUpdating and DisplayAlerts at the end of your routine.
Any time you use
Application.ScreenUpdating = False
Application.DisplayAlerts = False
you need to make sure that you are using error handling to manage if your code breaks.
On Error GoTo ExitErr
Application.ScreenUpdating = False
Application.DisplayAlerts = False
<your code here>
ExitErr:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
This makes sure that if your code breaks (in your case the most obvious being someone renaming "Sheet1"), Excel isn't left with ScreenUpdating and DisplayAlerts left turned off. I can't tell you how many times I've had to fix other people's code because they turned off these functions and then couldn't figure out why Excel was acting up.
Related
With below code, no errors are displayed, the read file opens but it seems not data is copied.
I am trying to copy only a number of columns, but it seems nothing is been copied to current workbook.
Any help would be appreciated as I am very new with VBA
Sub ReadDataFromCloseFile()
On Error GoTo ErrHandler
'stop screen update
Application.ScreenUpdating = False
Dim src As Workbook
Dim sTheSourceFile As String
sTheSourceFile = "C:\Users\grmn\Desktop\testreadfile.xlsx"
Set src = Workbooks.Open(sTheSourceFile, True, True)
Dim iRowsCount As Long
'source of data
With src.Worksheets("Sheet1")
iRowsCount = .Range("A1:A" & .Cells(Rows.Count, "A").End(xlUp).Row).Rows.Count
End With
Dim iCnt As Long
'destination sheet thisWorkbook.sheet("rapport")
For iCnt = 1 To iRowsCount
Worksheets("rapport").Range("A" & iCnt).Formula = src.Worksheets("Sheet1").Range("A" & iCnt).Formula
Worksheets("rapport").Range("F" & iCnt).Formula = src.Worksheets("Sheet1").Range("B" & iCnt).Formula
Next iCnt
'close but not overide source file (src).
src.Close False
Set src = Nothing
ErrHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
No worries being new, we all were at some point.
The first part of your code 'source of data doesn't work as intended. iRowsCount is an Integer and not an Array. To make use of an array, as you seemingly tried to do, you should use
Dim iRowsCount(8) As Long
With src.Worksheets("Sheet")
iRowsCount(1) = .Range("A1:A" & .Cells(Rows.Count, "A").End(xlUp).Row).Rows.Count
' ...
End With
' ...
If you use an Integer only the last row will be assigned. So if "AT", for some reason, has 5 rows, iRowsCount will be 5. Nothing else. Not accounting for "AQ" or "AS".
But in your case, Integer/Long would probably suffice if all rows have the exact same count. One assignment would be enough then.
Regarding .Formula - are you really trying to write formulas? Have you tried .value instead?
And, what may be the crux of the matter, try Worksheets("rapport").Save or Worksheets("rapport").SaveAs at the end of your function.
(Haven't tested it on my end so far.)
Additionally, please remember to set Exit Sub (or Exit Function respectively, if a Function) to avoid executing ErrHandler if no error occurs.
(Sorry, I'm new to Stackoverflow, so I can't write comments as of yet.)
(Edit: Thanks for the reminder, #FunThomas, Integer is only -32768 to 32767. Long is 8 bytes.)
I am trying to make a macro to open a word document and make track changes in accordance with column A and B.
I got this to work, but only if the document that is opened in the track changes mode "Simple Markup".
If it is in any other mode, and I have the following search sentences.
A1: al anden personer B1: alle andre mennesker
A2: anden personer B2: andre mennesker
And the text in the word document is "al anden personer".
The text will be "alle andre menneskerandre mennesker" in other world it will search in the track changes.
Therefore, I am trying to make the Word document always open in simple markup. I have tried using iteration of
ActiveWindow.View.RevisionsFilter.Markup = wdRevisionsMarkupSimple
but could not get it to work.
Hope you can help.
PS: I am fairly new to VBA so if you have any other improvement or hint the I'm all ears.
My code right now is:
Option Explicit
Const wdReplaceAll = 2
Sub FindReplace()
Dim wordApp As Object
Dim wordDoc As Object
Dim myStoryRange As Object
Dim cell As Range
Dim Find1 As String
Dim Replace1 As String
Const wdRevisionsMarkupSimple As Integer = 1
'Dim oRevision As Revision
If Not FileIsOpen("H:\Til excel replace test ark" & ".docx") Then
Set wordApp = CreateObject("Word.Application")
wordApp.Visible = True
Set wordDoc = wordApp.Documents.Open("H:\Til excel replace test ark.docx")
wordDoc.trackrevisions = True
'ActiveWindow.View.RevisionsFilter.Markup = wdRevisionsMarkupSimple cannot get it to work
Else
On Error GoTo ExitSub
End If
With Worksheets("sheet1")
For Each cell In Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
Find1 = cell.Value
Replace1 = cell.Offset(0, 1).Value
For Each myStoryRange In wordDoc.StoryRanges
With myStoryRange.Find
.MatchCase = True
.matchwholeword = True
.Text = Find1
.Forward = True
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.Replacement.Text = Replace1
.Execute Replace:=wdReplaceAll
End With
Next myStoryRange
Next cell
End With
Exit Sub
ExitSub:
MsgBox "Luk word document før du benytter denne macro"
End Sub
Public Function FileIsOpen(FullFilePath As String) As Boolean
Dim ff As Long
On Error Resume Next
ff = FreeFile()
Open FullFilePath For Input Lock Read As #ff
Close ff
FileIsOpen = (Err.Number <> 0)
On Error GoTo 0
End Function
Your issue is a result of your use of late binding.
When using late binding you cannot use the enums or constants from the Word object library, e.g. wdRevisionsMarkupSimple, as Excel doesn't know what those represent. You either have to declare those constants yourself or use their underlying values.
So to activate revisions with simple markup your code needs to be:
ActiveWindow.View.RevisionsFilter.Markup = 1 'wdRevisionsMarkupSimple
EDIT: I also missed something else obvious - Excel also has ActiveWindow in its object model. When writing code across applications you need to be absolutely scrupulous in specifying which application/object the line of code refers to. In this case it should be:
WordApp.ActiveWindow.View.RevisionsFilter.Markup = 1 'wdRevisionsMarkupSimple
You can avoid these errors by adding Option Explicit at the top of the code module. This will prevent your code from compiling when you have undeclared variables. To add this automatically open the VBE and go to Tools | Options. In the Options dialog ensure that Require Variable Declaration is checked.
I'm getting a problem, when I try to run these commands. Problem come from the formula expresion, since "_" is a syntax error, but I need exactly that formula in my Excel cells,
How could I solve it out?
Sub Prueba_Fernando()
Application.ScreenUpdating = False
Range("B:B").Columns.Insert
Range("B1").FormulaLocal = "=EXTRAE(A1;HALLAR("_";A1;2)+1;LARGO(A1)-HALLAR("_";A1;1))"
Set h1 = Sheets("Hoja1")
h1.Range("B1").Copy
For Each h In Sheets
u = h.Range("A" & Rows.Count).End(xlUp).Row
h1.Range("B2:B" & u).PasteSpecial xlAll
Next
MsgBox "Fórmulas aplicadas"
Dim xColIndex As Integer
Dim xRowIndex As Integer
xIndex = Application.ActiveCell.Column
xRowIndex = Application.ActiveSheet.Cells(Rows.Count, xIndex).End(xlUp).Row
Range(Cells(3, xIndex), Cells(xRowIndex, xIndex)).Copy
Application.ScreenUpdating = True
MsgBox "Información copiada a Portapapeles"
End Sub
You're right, the problem lies in the formula.
It is caused by ", when you want to have double-quete inside a string, you need to double it, otherwise it will be interpreted as end of the string, thus errors.
Use this line:
Range("B1").FormulaLocal = "=EXTRAE(A1;HALLAR(""_"";A1;2)+1;LARGO(A1)-HALLAR(""_"";A1;1))"
Private Sub Workbook_Open()
Dim SourceList(0) As Workbook
Dim PathList() As String
Dim n As Integer
PathList = Split("\data\WeaponInfo.csv", ",")
ThisWorkbook.Activate
Application.ActiveWindow.Visible = False
Application.ScreenUpdating = False
For n = 0 To Ubound(PathList)
Workbooks.Open Filename:=ThisWorkbook.Path & PathList(n)
Set SourceList(n) = ActiveWorkbook
ActiveWindow.Visible = False
Next
Application.ScreenUpdating = True
Workbooks.Open Filename:=ThisWorkbook.Path & "\HeroForge Anew 3.5 v7.4.0.1.xlsm", UpdateLinks:=3
ActiveWindow.Visible = True
Application.DisplayAlerts = False
For n = 0 To UBound(SourceList)
SourceList(n).Close
Next
Application.DisplayAlerts = True
End Sub
The line For n = 0 to PathList.GetUpperBound(0) is throwing a "Compile Error (invalid qualifier) whenever I try to run this macro. Specifically it highlights PathList as being the problem.
Also, if I cut out the loop and just have the contents run once (replacing the PathList(n) with "\data\WeaponInfo.csv"), it throws an "Object Variable or With block variable not set" error on the SourceList(0) = ActiveWorkbook line. What am I doing wrong?
I'm aware that the loop is currently pointless; it's futureproofing as I'm going to be using this macro to open multiple data references.
EDIT: Made changes suggested by #Jeremy below, now getting the "Object variable or With block variable not set" error on the SourceList(n).Close line.
EDIT2: Fixed the loop, again on the advice of #Jeremy, by changing Dim SourceList(1) As Workbook to Dim SourceList(0) As Workbook
A couple of issues:
In VBA, the GetUpperBound method does not exist, it is for .NET only. Change it to Ubound function.
You may run into a problem with Sourcelist(0) = ActiveWorkbook. Use the Set keyword when assigning object references.
Source is not defined in your loop. ALWAYS put Option Explicit at the top of your code module to force you to declare your variables. It will save pain in the future.
What are you trying to do with splitting that string? you will just get one value, which is the string you are passing in.
Private Sub Workbook_Open()
Dim SourceList(1) As Workbook
Dim PathList() As String
Dim n as Integer
PathList = Split("\data\WeaponInfo.csv", ",")
ThisWorkbook.Activate
Application.ActiveWindow.Visible = False
Application.ScreenUpdating = False
For n = 0 To Ubound(PathList)
Workbooks.Open Filename:=ThisWorkbook.Path & PathList(n)
Set SourceList(0) = ActiveWorkbook
Next
ActiveWindow.Visible = False
Application.ScreenUpdating = True
Workbooks.Open Filename:=ThisWorkbook.Path & "\HeroForge Anew 3.5 v7.4.0.1.xlsm", UpdateLinks:=3
ActiveWindow.Visible = True
For Each Source In SourceList
Source.Close
Next
End Sub
I'm creating a small piece of VBA code with a specific formula, however it has a couple of if statements, one of which originates a double-line string (with vbNewLine)
The issue is that I can't see the text.
So I wanted to word wrap it, but each time I set the ActiveCell.WrapText = True, nothing happens.
I checked with a message box. I set the WrapText to True, I return the property value with the MessageBox to confirm, and it's still False.
I've been told to use ActiveCell.Rows.AutoFit as well, but AutoFit does nothing if the text isn't wrapped.
Any idea what I might be doing wrong here?
try:
Sub WrapandFit()
ActiveCell.WrapText = True
ActiveCell.EntireRow.AutoFit
End Sub
It worked for me. Make sure that your screenupdating is also set to true.
For me, the code below worked. (only set to change header row, (change range))
ActiveSheet.Range("A1:R1").Select
With Selection
.WrapText = True
End With
UDFs (procedures that use the keyword Function) only return values. They cannot change other parts of the Excel object model, like cell formatting. Only Subroutines (procedures that use the keyword Sub) can do that.
You need to have your cells formatted properly before you enter your UDF. Or you could use a worksheet change event sub to format them after the fact.
Turn off/On word wrap for whole sheet row can be done by VB code shown below:
If the first row is set true, excel inherits that property for whole sheet, unless you specifically turned it off using another code.
MyWorkSheet.Rows.WrapText = True
To turn off wrapping property of a specific row:
MyWorkSheet.Rows(8).WrapText = False
I suspect that you are trying to wrap text in merged cells. If yes, you cannot simply call:
MyWorkSheet.Rows.WrapText = True
Instead, you have to simulate the wrapping operations. I found the code from http://blog.contextures.com/archives/2012/06/07/autofit-merged-cell-row-height/ helped me last year.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MergeWidth As Single
Dim cM As Range
Dim AutoFitRng As Range
Dim CWidth As Double
Dim NewRowHt As Double
Dim str01 As String
str01 = "OrderNote"
If Not Intersect(Target, Range(str01)) Is Nothing Then
Application.ScreenUpdating = False
On Error Resume Next
Set AutoFitRng = Range(Range(str01).MergeArea.Address)
With AutoFitRng
.MergeCells = False
CWidth = .Cells(1).ColumnWidth
MergeWidth = 0
For Each cM In AutoFitRng
cM.WrapText = True
MergeWidth = cM.ColumnWidth + MergeWidth
Next
'small adjustment to temporary width
MergeWidth = MergeWidth + AutoFitRng.Cells.Count * 0.66
.Cells(1).ColumnWidth = MergeWidth
.EntireRow.AutoFit
NewRowHt = .RowHeight
.Cells(1).ColumnWidth = CWidth
.MergeCells = True
.RowHeight = NewRowHt
End With
Application.ScreenUpdating = True
End If
End Sub
This may not be exactly what the OP had in mind but I figured I'd share my VBA Word Wrap function since I couldn't find anything on the web to do what I wanted.
This function insert CR+LF's into the string in order to wrap it, so the word wrap is maintained if the text is copied to another application, text-based or otherwise.
Function wrapText(strIn As String, Optional maxLen As Long = 110) As String
Dim p As Long: wrapText = strIn
Do
p = InStrRev(wrapText, " ", p + maxLen) - 1
wrapText = Left(wrapText,p) & vbCrLf & Right(wrapText, Len(wrapText)-p-1)
Debug.Print Mid(Replace(wrapText, vbCrLf, "||"), p - 20)
'Stop
Loop While p + maxLen < Len(wrapText)
End Function
It defaults to maximum width of 115 characters but can optionally be changed to anything. It only breaks on spaces (the last one that appears on/before position #115), and it only inserts CR + LF's (with the constant vbCrLf), but they can be adapted as required.
As an example of application, I was building complex SQL queries in Excel and wanted to copy the SQL over to the server app neat & tidy, instead of one giant line.