Related
I am converting my unittest test cases to pytest.
While running my py file, the script does its function fine (device reboot) but my test script shows the following failure:
================================================================================================ FAILURES =================================================================================================
_________________________________________________________________________________________ TestReboot.test_reboot __________________________________________________________________________________________
../../custom_xmlrunner/custom_unittest_runner.py:245: in run
self.write_result(result)
_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
self = <device_reboot.TestReboot testMethod=test_reboot>, result = <TestCaseFunction test_reboot>
def write_result(self, result):
"""
Write the result of the test-case, like:
-----------------------
TESTCASE: my_test_case
RESULT: PASS
-----------------------
This too is implicitly called at the end of the test-case.
"""
self.write_log('-' * 60)
self.write_log('TESTCASE: {0}'.format(self._testMethodName))
> if result.wasSuccessful():
E AttributeError: 'TestCaseFunction' object has no attribute 'wasSuccessful'
../../custom_xmlrunner/custom_unittest_runner.py:292: AttributeError
I am trying to pull the data through power query but I am getting a "invalid procedure call or Argument" error
I have tried other options using arrays and lin input but as they were taking too much time, I have to shift to another option.
Error is in line: ActiveWorkbook.Queries.Add Name:=QueryName, Formula:=SourceFormula)
Below is the code:
Sub Import_AACR()
Dim QueryName, SourceFormula, ConnStr As String
QueryName = "AACR_Pull"
SourceFormula = "let Source = Csv.Document(File.Contents(""C:\ENDO AACR\AACR_20200123_2020Q1_V6.0.txt""),[Delimiter=""|"", Columns=27, Encoding=1252, QuoteStyle=QuoteStyle.None])," & _
"#""Promoted Headers"" = Table.PromoteHeaders(Source, [PromoteAllScalars=true])," & _
"#""Changed Type"" = Table.TransformColumnTypes(#""Promoted Headers"",{{""REQUEST#"", Int64.Type}, {""REQUEST_SUBMIT_DT"", type text}, {""REQUEST_SUBMIT_TYPE"", type text}, {""SALES_TEAM"", type text}, {""DM_NAME"", type text}, {""STATUS"", type text}})in #""Changed Type"""
ActiveWorkbook.Queries.Add Name:=QueryName, Formula:=SourceFormula
Connstr = "OLEDB;" & _
"Provider = Microsoft.Mashup.OleDb.1;" & _
"Data Source = $Workbook$;" & _
"Location=""AACR_Pull"";" & _
"Extended Properties="""""
With ActiveSheets.ListObjects.Add(SourceType = xlSrExternal, _
LinkSource:=True, _
xlListObjectHasHeaders:=xlYes, _
Source:=Connstr, _
TableStyleName:="TableStyleMedium8", _
Destinatio:=Range("A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [AACR_Pull]")
.Refresh BackgroundQuery = False
End With
End Sub
The Source Formula query is copy-pasted from the power query editor and I have just used additional escape characters.
After looking into it for a day, I have found another workaround for importing the same text file with delimiters.
Instead of doing it through power query which loads a table, I have recorded a macro and have made some tweaks
Below is the updated code:
Sub Load_File()
Dim Old_File_Name As String
Dim New_File_Name As String
Old_File_Name = Worksheets("SUMMARY").Range("I3").Value
New_File_Name = Worksheets("SUMMARY").Range("I4").Value
File_Path_Old = "C:\ENDO AACR" & "\" & Old_File_Name
File_Path_New = "C:\ENDO AACR" & "\" & New_File_Name
Application.ScreenUpdating = False
Worksheets("OLD").Range("A1:AA1500").ClearContents
ChDir "C:\Filepath"
Workbooks.OpenText Filename:=File_Path_Old, _
Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=True, OtherChar:="|", FieldInfo:= _
Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7 _
, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array _
(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), _
Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array( _
27, 1)), TrailingMinusNumbers:=True
Range("A1:AA1500").Select
Selection.Copy
Windows("AACR_Automated.xlsm").Activate
ThisWorkbook.Worksheets("OLD").Select
Worksheets("OLD").Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Workbooks(Old_File_Name).Activate
ActiveWindow.Close
Application.ScreenUpdating = True
End Sub ()
I am creating a private excel program that has multiple different currency format cells across the workbook.
I want to change all currency cells in the workbook from one currency to a selected currency.
This process must happen quickly and efficiently.
Any ideas?
I have been looking at multiple threads and no luck. I do not seam to find any threads that can quickly change the currency symbol of every currency cell.
Here are links to some sites I have tried:
- https://www.pcreview.co.uk/threads/vba-code-to-change-currency-format.3861711/
- https://social.msdn.microsoft.com/Forums/office/en-US/5828423e-96dd-4cae-8404-7d5d8adb328c/finding-all-currency-formatted-cells-and-change-the-currency-symbol?forum=exceldev
- https://www.reddit.com/r/excel/comments/4dcha1/i_need_a_way_to_change_all_currency_cells_across/
- https://www.ozgrid.com/forum/forum/help-forums/excel-general/67104-change-currency-symbol-from-list?t=77206
-https://chandoo.org/forum/threads/how-to-change-the-currency-symbol-dynamically-in-excel.7673/
-https://contexturesblog.com/archives/2010/06/23/conditional-formatting-for-currency-symbol/
I have not included all threads I looked at previously.
I just require something quick and efficient.
CODE:
Dim cur As Range
Set cur = Range("e12")
If Not Application.Intersect(cur, Range(Target.Address)) _
Is Nothing Then
If cur = "Dollar" Then
If Sheets("Summary").Range("e15").NumberFormat = _
"_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-#_ " Then
Application.FindFormat.NumberFormat = _
"_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-#_ "
Application.ReplaceFormat.NumberFormat = _
"_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-#_ "
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_-* #,##0.00 [$€-de-DE]_-;-* #,##0.00 [$€-de-DE]_-;_-* ""-""?? [$€-de-DE]_-;_-#_-" Then
Application.FindFormat.NumberFormat = _
"_-* #,##0.00 [$€-de-DE]_-;-* #,##0.00 [$€-de-DE]_-;_-* ""-""?? [$€-de-DE]_-;_-#_-"
Application.ReplaceFormat.NumberFormat = _
"_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-#_ "
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-#_-" Then
Application.FindFormat.NumberFormat = _
"_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-#_-"
Application.ReplaceFormat.NumberFormat = _
"_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-#_ "
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_-* #,##0.00 [$?.?.?-ar-AE]_-;-* #,##0.00 [$?.?.?-ar-AE]_-;_-* ""-""?? [$?.?.?-ar-AE]_-;_-#_-" Then
Application.FindFormat.NumberFormat = _
"_-* #,##0.00 [$?.?.?-ar-AE]_-;-* #,##0.00 [$?.?.?-ar-AE]_-;_-* ""-""?? [$?.?.?-ar-AE]_-;_-#_-"
Application.ReplaceFormat.NumberFormat = _
"_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-#_ "
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(#_)" Then
Application.FindFormat.NumberFormat = _
"_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(#_)"
Application.ReplaceFormat.NumberFormat = _
"_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-#_ "
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
End If
ElseIf cur = "Euro" Then
If Sheets("Summary").Range("e15").NumberFormat = _
"_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-#_ " Then
Application.FindFormat.NumberFormat = _
"_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-#_ "
Application.ReplaceFormat.NumberFormat = _
"_-* #,##0.00 [$€-de-DE]_-;-* #,##0.00 [$€-de-DE]_-;_-* ""-""?? [$€-de-DE]_-;_-#_-"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_-* #,##0.00 [$€-de-DE]_-;-* #,##0.00 [$€-de-DE]_-;_-* ""-""?? [$€-de-DE]_-;_-#_-" Then
Application.FindFormat.NumberFormat = _
"_-* #,##0.00 [$€-de-DE]_-;-* #,##0.00 [$€-de-DE]_-;_-* ""-""?? [$€-de-DE]_-;_-#_-"
Application.ReplaceFormat.NumberFormat = _
"_-* #,##0.00 [$€-de-DE]_-;-* #,##0.00 [$€-de-DE]_-;_-* ""-""?? [$€-de-DE]_-;_-#_-"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-#_-" Then
Application.FindFormat.NumberFormat = _
"_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-#_-"
Application.ReplaceFormat.NumberFormat = _
"_-* #,##0.00 [$€-de-DE]_-;-* #,##0.00 [$€-de-DE]_-;_-* ""-""?? [$€-de-DE]_-;_-#_-"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_-* #,##0.00 [$?.?.?-ar-AE]_-;-* #,##0.00 [$?.?.?-ar-AE]_-;_-* ""-""?? [$?.?.?-ar-AE]_-;_-#_-" Then
Application.FindFormat.NumberFormat = _
"_-* #,##0.00 [$?.?.?-ar-AE]_-;-* #,##0.00 [$?.?.?-ar-AE]_-;_-* ""-""?? [$?.?.?-ar-AE]_-;_-#_-"
Application.ReplaceFormat.NumberFormat = _
"_-* #,##0.00 [$€-de-DE]_-;-* #,##0.00 [$€-de-DE]_-;_-* ""-""?? [$€-de-DE]_-;_-#_-"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(#_)" Then
Application.FindFormat.NumberFormat = _
"_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(#_)"
Application.ReplaceFormat.NumberFormat = _
"_-* #,##0.00 [$€-de-DE]_-;-* #,##0.00 [$€-de-DE]_-;_-* ""-""?? [$€-de-DE]_-;_-#_-"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
End If
ElseIf cur = "Pound" Then
'dollar to dirham
If Sheets("Summary").Range("e15").NumberFormat = _
"_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-#_ " Then
Application.FindFormat.NumberFormat = _
"_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-#_ "
Application.ReplaceFormat.NumberFormat = _
"_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-#_-"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_-* #,##0.00 [$€-de-DE]_-;-* #,##0.00 [$€-de-DE]_-;_-* ""-""?? [$€-de-DE]_-;_-#_-" Then
Application.FindFormat.NumberFormat = _
"_-* #,##0.00 [$€-de-DE]_-;-* #,##0.00 [$€-de-DE]_-;_-* ""-""?? [$€-de-DE]_-;_-#_-"
Application.ReplaceFormat.NumberFormat = _
"_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-#_-"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-#_-" Then
Application.FindFormat.NumberFormat = _
"_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-#_-"
Application.ReplaceFormat.NumberFormat = _
"_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-#_-"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_-* #,##0.00 [$?.?.?-ar-AE]_-;-* #,##0.00 [$?.?.?-ar-AE]_-;_-* ""-""?? [$?.?.?-ar-AE]_-;_-#_-" Then
Application.FindFormat.NumberFormat = _
"_-* #,##0.00 [$?.?.?-ar-AE]_-;-* #,##0.00 [$?.?.?-ar-AE]_-;_-* ""-""?? [$?.?.?-ar-AE]_-;_-#_-"
Application.ReplaceFormat.NumberFormat = _
"_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-#_-"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(#_)" Then
Application.FindFormat.NumberFormat = _
"_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(#_)"
Application.ReplaceFormat.NumberFormat = _
"_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-#_-"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
End If
ElseIf cur = "Dirham" Then
'dollar to dirham
If Sheets("Summary").Range("e15").NumberFormat = _
"_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-#_ " Then
Application.FindFormat.NumberFormat = _
"_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-#_ "
Application.ReplaceFormat.NumberFormat = _
"_-* #,##0.00 [$?.?.?-ar-AE]_-;-* #,##0.00 [$?.?.?-ar-AE]_-;_-* ""-""?? [$?.?.?-ar-AE]_-;_-#_-"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_-* #,##0.00 [$€-de-DE]_-;-* #,##0.00 [$€-de-DE]_-;_-* ""-""?? [$€-de-DE]_-;_-#_-" Then
Application.FindFormat.NumberFormat = _
"_-* #,##0.00 [$€-de-DE]_-;-* #,##0.00 [$€-de-DE]_-;_-* ""-""?? [$€-de-DE]_-;_-#_-"
Application.ReplaceFormat.NumberFormat = _
"_-* #,##0.00 [$?.?.?-ar-AE]_-;-* #,##0.00 [$?.?.?-ar-AE]_-;_-* ""-""?? [$?.?.?-ar-AE]_-;_-#_-"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-#_-" Then
Application.FindFormat.NumberFormat = _
"_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-#_-"
Application.ReplaceFormat.NumberFormat = _
"_-* #,##0.00 [$?.?.?-ar-AE]_-;-* #,##0.00 [$?.?.?-ar-AE]_-;_-* ""-""?? [$?.?.?-ar-AE]_-;_-#_-"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_-* #,##0.00 [$?.?.?-ar-AE]_-;-* #,##0.00 [$?.?.?-ar-AE]_-;_-* ""-""?? [$?.?.?-ar-AE]_-;_-#_-" Then
Application.FindFormat.NumberFormat = _
"_-* #,##0.00 [$?.?.?-ar-AE]_-;-* #,##0.00 [$?.?.?-ar-AE]_-;_-* ""-""?? [$?.?.?-ar-AE]_-;_-#_-"
Application.ReplaceFormat.NumberFormat = _
"_-* #,##0.00 [$?.?.?-ar-AE]_-;-* #,##0.00 [$?.?.?-ar-AE]_-;_-* ""-""?? [$?.?.?-ar-AE]_-;_-#_-"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(#_)" Then
Application.FindFormat.NumberFormat = _
"_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(#_)"
Application.ReplaceFormat.NumberFormat = _
"_-* #,##0.00 [$?.?.?-ar-AE]_-;-* #,##0.00 [$?.?.?-ar-AE]_-;_-* ""-""?? [$?.?.?-ar-AE]_-;_-#_-"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
End If
ElseIf cur = "Rand" Then
If Sheets("Summary").Range("e15").NumberFormat = _
"_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-#_ " Then
Application.FindFormat.NumberFormat = _
"_-[$$-en-US]* #,##0.00_ ;_-[$$-en-US]* -#,##0.00 ;_-[$$-en-US]* ""-""??_ ;_-#_ "
Application.ReplaceFormat.NumberFormat = _
"_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(#_)"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_-* #,##0.00 [$€-de-DE]_-;-* #,##0.00 [$€-de-DE]_-;_-* ""-""?? [$€-de-DE]_-;_-#_-" Then
Application.FindFormat.NumberFormat = _
"_-* #,##0.00 [$€-de-DE]_-;-* #,##0.00 [$€-de-DE]_-;_-* ""-""?? [$€-de-DE]_-;_-#_-"
Application.ReplaceFormat.NumberFormat = _
"_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(#_)"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-#_-" Then
Application.FindFormat.NumberFormat = _
"_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-#_-"
Application.ReplaceFormat.NumberFormat = _
"_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(#_)"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_-* #,##0.00 [$?.?.?-ar-AE]_-;-* #,##0.00 [$?.?.?-ar-AE]_-;_-* ""-""?? [$?.?.?-ar-AE]_-;_-#_-" Then
Application.FindFormat.NumberFormat = _
"_-* #,##0.00 [$?.?.?-ar-AE]_-;-* #,##0.00 [$?.?.?-ar-AE]_-;_-* ""-""?? [$?.?.?-ar-AE]_-;_-#_-"
Application.ReplaceFormat.NumberFormat = _
"_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(#_)"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
ElseIf Sheets("Summary").Range("e15").NumberFormat = _
"_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(#_)" Then
Application.FindFormat.NumberFormat = _
"_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(#_)"
Application.ReplaceFormat.NumberFormat = _
"_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(#_)"
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
End If
'
'
'
'
End If
End If
Solution if simple:
Make if statements the option in drop down.
Make this code run anytime a new selection is chosen and run all replace functions as none will evaluate a error. Easy bypass but effective nonetheless.
Code:
Range("o14").NumberFormat = "-[$$-en-US]* #,##0.00 ;-[$$-en-US]* -#,##0.00 ;-[$$-en-US]* ""-""??_ ;-# "
Range("o18").NumberFormat = "($* #,##0.00);($* (#,##0.00);($* ""-""??);(#)"
Range("o16").NumberFormat = "-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* ""-""??-;-#-"
Range("o15").NumberFormat = "-* #,##0.00 [$€-de-DE]-;-* #,##0.00 [$€-de-DE]-;-* ""-""?? [$€-de-DE]-;-#-"
Range("o17").NumberFormat = "-[$" & "AED" & "-en-US]* # ##0.00_) ;[Color46]-([$" & "AED" & "-en-US]* -# ##0.00) ;-[$" & "AED" & "-en-US]* ""-""??_ ;(#)"
I'm trying to create an Excel VBA macro to look down a list one cell at a time to check if it's empty and then save a corresponding number of sheets equal to 3x the number of non-empty cells.
Here's the code for what I'm doing. I thought about using a loop within a loop, but I wasn't sure how to implement it or if it would work, so I used this, which does work.
Sub SaveMacro()
Dim Cell As Variant
Dim bFileSaveAs As Boolean
'For j = 0 To 12
Set Cell = Range("B3")
If Not IsEmpty(Cell) Then
Sheets(Array("L12", "L13-24", "L25-36")).Select
If Not IsEmpty(Cell.Offset(1, 0)) Then
Sheets(Array("L12", "L13-24", "L25-36", "L12 (2)", "L13-24 (2)", "L25-36 (2)")).Select
If Not IsEmpty(Cell.Offset(2, 0)) Then
Sheets(Array("L12", "L13-24", "L25-36" _
, "L12 (2)", "L13-24 (2)", "L25-36 (2)" _
, "L12 (3)", "L13-24 (3)", "L25-36 (3)")).Select
If Not IsEmpty(Cell.Offset(3, 0)) Then
Sheets(Array("L12", "L13-24", "L25-36" _
, "L12 (2)", "L13-24 (2)", "L25-36 (2)" _
, "L12 (3)", "L13-24 (3)", "L25-36 (3)" _
, "L12 (4)", "L13-24 (4)", "L25-36 (4)")).Select
If Not IsEmpty(Cell.Offset(4, 0)) Then
Sheets(Array("L12", "L13-24", "L25-36" _
, "L12 (2)", "L13-24 (2)", "L25-36 (2)" _
, "L12 (3)", "L13-24 (3)", "L25-36 (3)" _
, "L12 (4)", "L13-24 (4)", "L25-36 (4)" _
, "L12 (5)", "L13-24 (5)", "L25-36 (5)")).Select
If Not IsEmpty(Cell.Offset(5, 0)) Then
Sheets(Array("L12", "L13-24", "L25-36" _
, "L12 (2)", "L13-24 (2)", "L25-36 (2)" _
, "L12 (3)", "L13-24 (3)", "L25-36 (3)" _
, "L12 (4)", "L13-24 (4)", "L25-36 (4)" _
, "L12 (5)", "L13-24 (5)", "L25-36 (5)" _
, "L12 (6)", "L13-24 (6)", "L25-36 (6)")).Select
End If
End If
End If
End If
Sheets("L12").Activate
bFileSaveAs = Application.Dialogs(xlDialogSaveAs).Show
End Sub
See if this does what you expect:
Sub SaveMacro()
Dim Cell As Range: Set Cell = Range("B3")
Dim sFileSaveAs As String
Dim R As Long, Z As Long, X As Long
Dim strSheets As String: strSheets = "L12,L13-24,L25-36"
Dim arrSheets(1 To 6) As Variant
Dim arrSheet() As String: arrSheet = Split(strSheets, ",")
For R = LBound(arrSheets) To UBound(arrSheets)
If R = 1 Then
arrSheets(R) = arrSheet
Else
arrSheets(R) = strSheets
For Z = 2 To R
For X = LBound(arrSheet) To UBound(arrSheet)
arrSheets(R) = arrSheets(R) & "," & arrSheet(X) & " (" & Z & ")"
Next X
Next Z
arrSheets(R) = Split(arrSheets(R), ",")
End If
Next R
For R = Cell.Row + 5 To Cell.Row Step -1
If Not IsEmpty(Cells(R, "B")) Then
Sheets(arrSheets(R - 2)).Copy
Exit For
End If
Next R
sFileSaveAs = ThisWorkbook.Path & "\range of sheets.xlsm"
ActiveWorkbook.SaveAs sFileSaveAs
End Sub
You can integrate this little selector in your macro by calling it, e.g. SelectSheets 3:
Sub SelectSheets(lCount As Long)
Dim lLoop As Long
If lLoop >= 1 Then Sheets(Array("L12", "L13-24", "L25-36")).Select
For lLoop = 2 To lCount
Sheets("L12 (" & lLoop & ")").Select False
Sheets("L13-24 (" & lLoop & ")").Select False
Sheets("L25-36 (" & lLoop & ")").Select False
Next
End Sub
This question already has answers here:
How can I assign a Variant to a Variant in VBA?
(5 answers)
Closed 3 years ago.
So I'm making a funky VBA class for callback objects. Currently one of the issues is that when returning data from the function's call method I have to run the method twice, one to determine the variable type and another to return the variable:
If VarType(Application.Run(Callback("Parent") & "." & Callback("Name"), args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21), args(22), args(23), args(24), args(25), args(26), args(27), args(28), args(29))) = vbObject Then
Set CallCallback = Application.Run( _
Callback("Parent") & "." & Callback("Name"), _
args(0), args(1), _
args(2), args(3), _
args(4), args(5), _
args(6), args(7), _
args(8), args(9), _
args(10), args(11), _
args(12), args(13), _
args(14), args(15), _
args(16), args(17), _
args(18), args(19), _
args(20), args(21), _
args(22), args(23), _
args(24), args(25), _
args(26), args(27), _
args(28), args(29))
Else
CallCallback = Application.Run( _
Callback("Parent") & "." & Callback("Name"), _
args(0), args(1), _
args(2), args(3), _
args(4), args(5), _
args(6), args(7), _
args(8), args(9), _
args(10), args(11), _
args(12), args(13), _
args(14), args(15), _
args(16), args(17), _
args(18), args(19), _
args(20), args(21), _
args(22), args(23), _
args(24), args(25), _
args(26), args(27), _
args(28), args(29))
End If
Recently I figured that I might be able to do this without calling the VBA function multiple times by dereferencing the result using VarPtr and then using GetMem4:
Private Declare Function GetMem4 Lib "msvbvm60.dll" (ByVal Addr As Long, ByRef RetVal As Any) As Long
...
Dim vp As LongPtr, vRet as Variant
vp = VarPtr(Application.Run(Callback("Parent") & "." & Callback("Name"), args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21), args(22), args(23), args(24), args(25), args(26), args(27), args(28), args(29)))
Call GetMem4(vp, vRet)
This specific example didn't work but I was wondering whether there was an obvious reason as to why this didn't work?
Any ideas?
I asked the question to vbforums also and they got there much faster than stackoverflow!
The solution is extremely simple:
Public Declare Sub VariantCopy Lib "oleaut32.dll" (ByRef pvargDest As Variant, ByRef pvargSrc As Variant)
...
VariantCopy CallCallback, Application.Run( _
Callback("Parent") & "." & Callback("Name"), _
args(0), args(1), _
args(2), args(3), _
args(4), args(5), _
args(6), args(7), _
args(8), args(9), _
args(10), args(11), _
args(12), args(13), _
args(14), args(15), _
args(16), args(17), _
args(18), args(19), _
args(20), args(21), _
args(22), args(23), _
args(24), args(25), _
args(26), args(27), _
args(28), args(29))
Simple!