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))"
Related
I have a macro (below) that inserts a new row into an un-defined number of Named ranges using ParamArray, it works fine except for when I try to assign the macro with more than 5-6 arguments I get a message box that says "Formula Too Complex to Assign To Object" (see picture above)
(see assignment string below)
'InsertNewRow "ServiceCrewDay_EmployeeList", "SAP_SCD_InPool", "SAP_SCD_OutPool", "SAP_SCD_SecondaryIn", "SAP_SCD_SecondaryOut", "SAP_SCD_ORD","SAP_SCD_THF","SAP_SCD_LH", "SAP_SCD_LH"'
Macro:
Sub InsertNewRow(ParamArray args() As Variant)
Dim ans: ans = MsgBox("WARNING: " & vbNewLine _
& "Action Cannot be undone!" & vbNewLine & "Continue?", vbYesNo, "Warning!")
If ans = vbNo Then: Exit Sub
Call HaltOperations
Call ActiveSheet.Unprotect()
Call Sheets("SAP Timesheet").Unprotect()
On Error GoTo OnError_Exit
'Loop and Check All Named Ranges Exist Before Proceeding
For Each a In args
If RangeExists(a) = False Then
MsgBox ("Named Range: " & a & " Not Defined!" & vbNewLine & "Operation Cancelled")
Exit Sub
End If
Next a
Dim rng As Range
'ADD ROW TO EACH NAMED INPUT RANGE
For Each a In args
Set rng = Range(a)
With rng
.Rows(.Rows.count).EntireRow.Insert
.Rows(.Rows.count - 2).EntireRow.Copy
.Rows(.Rows.count - 1).EntireRow.PasteSpecial (xlPasteFormulasAndNumberFormats)
On Error Resume Next: .Rows(.Rows.count - 1).EntireRow.PasteSpecial (xlPasteFormats)
End With
Next a
On Error GoTo OnError_Exit
'ADJUST HEIRACHY NUMBERS ON FIRST INPUT RANGE (MANNING TAB)
Set rng = Range(args(0))
Dim col As Integer
col = rng.Column
Cells(rng.Row + rng.Rows.count - 2, col).Offset(0, -1).Value _
= Cells(rng.Row + rng.Rows.count - 3, col).Offset(0, -1).Value + 1
Cells(rng.Row + rng.Rows.count - 1, col).Offset(0, -1).Value _
= Cells(rng.Row + rng.Rows.count - 3, col).Offset(0, -1).Value + 2
Call ResumeOperations
Application.CutCopyMode = False
Call ActiveSheet.Protect()
Call Sheets("SAP Timesheet").Protect()
Exit Sub
OnError_Exit:
Call ResumeOperations
Application.CutCopyMode = False
Call ActiveSheet.Protect()
Call Sheets("SAP Timesheet").Protect()
End Sub
Private Function RangeExists(rng As Variant) As Boolean
Dim Test As Range
On Error Resume Next
Set Test = Range(rng)
RangeExists = Err.Number = 0
End Function
Private Sub HaltOperations()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
End Sub
Private Sub ResumeOperations()
ResumeOps:
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub
The Macro itself runs as expected it's just the assigning the named ranges that is causing the issue.
is there a better way to do this?
or is there a way to get around the Formula is too complex method?
and if there is will that need to be done on all end user pc's or just on mine and the settings will carry over?
What I have thought about doing was just taking in 2 Named ranges and then for the following ranges Just offsetting those by the Row Count of the previous range so if Range2 = Sheets().Range("A1:A10") then Range3 = Range2.Offset(Range2.Rows.Count,0) then the assingment input would only need to be Range1 as string, Range2 as string, NumberOfExtraRanges as integer the reason I need atleast two ranges is because every range after range 1 is on a different tab and is essentially a raw data version of all pay info hours etc. in the first tab which will be Range1_EmployeeList
which I will play around with while I wait for a response.
TIA
Not a Complete answer but I did find that inside the ParamArray I could just assign One Input Range using a , to seperate each defined range. I haven't tested the limitations doing it this way but it does seem to atleast let me use a few extra inputs.
Example (Not Working):
Note: Each Defined Range is a Separate Input
'InsertNewRow "ServiceCrewDay_EmployeeList", "SAP_SCD_InPool" ," SAP_SCD_OutPool","SAP_SCD_SecondaryIn", "SAP_SCD_SecondaryOut"'
Example (Working):
Note Each Defined Range is passed as 1 input
'InsertNewRow "ServiceCrewDay_EmployeeList", "SAP_SCD_InPool, SAP_SCD_OutPool,SAP_SCD_SecondaryIn,SAP_SCD_SecondaryOut"'
I am creating a spreadsheet for a client to manage his ALM. I developped it under Excel and VBA, request of my client.
One sheet "Data" calculates all the vba functions. If i calculate manually each cell all works fine, but if i run the macro it did not.
Do you have a solution? I can post the entire file if needed, for a better investigation.
At the beginning all the calculation where in excel cell, but i created dedicated function for each table, because the file was too big when saved.
Public Sub Main()
Dim i, nb_tableaux As Integer
Dim j, lignemax, BarWidth As Long
Dim ProgressPercentage As Double
Dim echeancier, nomtableau As String
Dim ws_data As Worksheet
Dim c As Range
Me.ProgressLabel.Caption = "Initialisation terminée. "
Set ws_data = Sheets("Data")
lignemax = ws_data.Range("DATA").Rows.Count
Application.ScreenUpdating = True
Application.EnableEvents = True
nb_tableaux = 17
For i = 1 To nb_tableaux
echeancier = tab_Tableaux(i, 0)
nomtableau = tab_Tableaux(i, 1)
Me.ProgressLabel.Caption = "En cours : " & echeancier
ws_data.Range(nomtableau).Calculate
'With Worksheets("Data")
For j = 1 To lignemax
For Each c In ws_data.Range(nomtableau).Rows(j)
formulaToCopy = c.Formula
c.ClearContents
c.Value = formulaToCopy
DoEvents
Next
Me.ProgressLabel.Caption = "En cours : " & echeancier & ", " & Format(j / lignemax, "0.0%") & " completed"
Me.Repaint
Next j
'End With
Me.Bar.Width = i * 200 / nb_tableaux
Me.Bar.Caption = Format(i / nb_tableaux, "0%") & " completed"
Next i
Application.ScreenUpdating = False
Application.EnableEvents = False
End Sub
after taking into account the recommandations you gave me for my previous answers, the code works better, but still not for some of the ranges.
My issue come from a wrong calculation of a argument in the fonction.
In fact, I use ligne=activecell.row - 8, to get the ligne of the range to calculate. But it works if i do it manually, as the actual cell is activated, but not when i call the function many times, as i can not activate each cell, it will be too long for the spreadsheet.
How can i get ligne calculated, with the correct address of the cell where the function is written?
I hope i am clear enough. Sorry for my English.
Public Function Taux_Mois(ByVal mMois As Range, ByVal sScenario As Range)
Dim ligne As Long
ligne = ActiveCell.row - 8
Select Case (Range("DATA[Flag]").Cells(ligne).Value = 0) Or (Range("DATA[frequence fixing]").Cells(ligne).Value = 0)
Case True
Taux_Mois = 0
Exit Function
Case False
Dim index_taux As Integer
Dim ajust As Long
index_taux = CInt(Range("DATA[Indexation ID]").Cells(ligne).Value)
If index_taux = 1 Then
ajust = 0
Else
Dim ajust1, dernierfixingt0, freqfixing As Integer
dernierfixingt0 = Range("DATA[Dernier fixing t0]").Cells(ligne).Value
freqfixing = Range("DATA[frequence fixing]").Cells(ligne).Value
ajust1 = (Int((mMois.Value - dernierfixingt0) / freqfixing) * freqfixing)
ajust = Worksheets("Market Data").Range("Taux_" & sScenario.Value).Offset(12 + dernierfixingt0 + ajust1, 1 + index_taux).Value
End If
Taux_Mois = Range("DATA[facteur taux (TVA, base)]").Cells(ligne).Value * (ajust + Range("DATA[Spread / Taux]").Cells(ligne).Value / 10000)
Exit Function
End Select
End Function
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.
I'm actually trying to code the sumproduct VBA script but I'm getting the runtime 13 error...
VBA:
Option Explicit
Sub sample_sumpro()
Dim cal_date, nxt_date As Date
cal_date = #12/30/2016#
nxt_date = cal_date + 1
Dim name As String, ws As Sheets
name = "Kawale, Amar"
Dim dm_daily As String
With Sheets(1)
dm_daily = Application.Evaluate("SUMPRODUCT((Columns(16)=name)*Columns(4)>=cal_date)*Columns(4)<nxt_date))")
End With
MsgBox dm_daily
End Sub
In a comment to another answer, you say that you are actually trying to do a count with two criteria (or three criteria according to the question). That is better achieved with Excel's CountIfs function, which can be coded in VBA using something like:
Option Explicit
Sub sample_sumpro()
Dim cal_date As Date, nxt_date As Date
Dim name As String
Dim dm_daily As String
cal_date = #12/30/2016#
nxt_date = cal_date + 1
name = "Kawale, Amar"
With Sheets(1)
dm_daily = Application.WorksheetFunction.CountIfs(.Columns(16), name, _
.Columns(4), ">=" & CDbl(cal_date), _
.Columns(4), "<" & CDbl(nxt_date))
End With
MsgBox dm_daily
End Sub
I didn't get exactly what you're trying to do, but if (just a guess) you're trying to evaluate the SUMPRODUCT of columns 14 and 15, you might want to try this:
Sub TestEvaluate()
Dim ws As Worksheet, x As String
Set ws = Worksheets(2)
x = Evaluate("sumproduct(" & ws.Columns(14).Address & "," & ws.Columns(15).Address & ")")
MsgBox x
End Sub
I'm having some trouble with a macro for Excel. The snippet that's giving me trouble is responsible for:
1) allowing the user to select multiple column headers, one by one
2) taking the contents of each columns, in the order of header selection, and concatenating
Here's the code:
Dim concat1() As Range
Dim rng As Variant
Dim i As Variant
Dim g As Integer
Dim metalabels() As String
Dim concated As String
Dim s As Variant
lastrow = Cells(rows.Count, "A").End(xlUp).Row
i = 0
msgselect = MsgBox("Would you like to concatonate?", vbOKCancel)
On Error GoTo Errhandler
If msgselect = vbOK Then
Do
ReDim Preserve concat1(i)
Set concat1(i) = Application.InputBox("Select the headers you would like to concatonate", Default:=ActiveCell.Address, Type:=8)
msgselect = MsgBox("Another cell?", vbOKCancel)
i = i + 1
Loop While msgselect = vbOK
i = i - 1
Errhandler:
End If
ReDim metalabels(i)
For g = 0 To i
metalabels(g) = concat1(g).Text
Next
ActiveSheet.Range("a1").End(xlToRight).Offset(0, 1).Select
ActiveCell = "Situation"
For h = 1 To lastrow - 1
For g = 0 To UBound(metalabels)
concated = concated + metalabels(g) + ": " + concat1(g).Offset(h, 0).Text + " / "
Next
ActiveCell.Offset(h, 0).Value = concated
concated = ""
Next
End Sub
The problem is here:
Set concat1(i) = Application.InputBox("Select the headers you would like to concatonate", Default:=ActiveCell.Address, Type:=8)
If the user selects "Cancel," the code crashes since the loop depends on vbOK. So, I thought I'd put in an error handler, but, as it is, I get the "object variable or with block not set" error.
As you might sense, I'm still a nube with VB. Any help is greatly appreciated.
Thanks!
Place this after your End IF
If concat1(i) Is Nothing Then Exit Sub
Did you try adding if concat1(i) = false then exit sub before incrementing i?