How to loop through Excel rows - excel

I'm trying to build an Excel VBA script that runs through an Excel sheet and extracts reports from a SAP system and puts them in a specific folder.
The parameters start at A10 and B10 and these are put in the SAP screen fields where the report is created and downloaded in the folder on my desktop.
Please see here below an example of the Excel sheet and a screenshot of the SAP screen and the code I'm using.
The script works fine for the first parameters A10 and B10 (it extracts a report from the SAP system and puts it in the desired folder) however I would like to loop the script to extract reports automatically for the other parameters below A10 and B10 and beyond (Loop Until ActiveCell.Value = "")
Can someone help me with this? Where and how do I put the loop?
The code:
'Declaring variables for sub procedures
Option Explicit
Public SapGuiAuto, WScript, msgcol
Public objGui As GuiApplication
Public objConn As GuiConnection
Public session As GuiSession
'Creating sub procedure
Sub SAPCustomerReport()
'Pointing object variables to SAP session
Set SapGuiAuto = GetObject("SAPGUI")
Set objGui = SapGuiAuto.GetScriptingEngine
Set objConn = objGui.Children(0)
Set session = objConn.Children(0)
Dim Vendor As String
Dim CoCo As String
Dim FolderPath As String
Dim SAPOutputLayout As String
Vendor = ActiveWorkbook.ActiveSheet.Range("A10")
CoCo = ActiveWorkbook.ActiveSheet.Range("B10")
FolderPath = ActiveWorkbook.ActiveSheet.Range("B3")
SAPOutputLayout = ActiveWorkbook.ActiveSheet.Range("B4")
'Recorded SAP Script here
session.FindById("wnd[0]").Maximize
session.FindById("wnd[0]/tbar[0]/okcd").Text = "/nFBL1N"
session.FindById("wnd[0]").SendVKey 0
session.FindById("wnd[0]/usr/chkX_SHBV").Selected = True
session.FindById("wnd[0]/usr/chkX_MERK").Selected = True
session.FindById("wnd[0]/usr/chkX_PARK").Selected = True
session.FindById("wnd[0]/usr/ctxtKD_LIFNR-LOW").Text = Vendor
session.FindById("wnd[0]/usr/ctxtKD_BUKRS-LOW").Text = CoCo
session.FindById("wnd[0]/usr/ctxtPA_VARI").Text = SAPOutputLayout
session.FindById("wnd[0]/usr/ctxtPA_VARI").SetFocus
session.FindById("wnd[0]/usr/ctxtPA_VARI").CaretPosition = 12
session.FindById("wnd[0]/tbar[1]/btn[8]").Press
session.FindById("wnd[0]/mbar/menu[0]/menu[3]/menu[1]").Select
session.FindById("wnd[1]/usr/ctxtDY_PATH").Text = FolderPath
session.FindById("wnd[1]/usr/ctxtDY_FILENAME").Text = Vendor & CoCo & ".XLSX"
session.FindById("wnd[1]/usr/ctxtDY_FILENAME").CaretPosition = 4
session.FindById("wnd[1]/tbar[0]/btn[11]").Press
MsgBox "Script Completed."
End Sub

A solution could look like this:
Sub SAPCustomerReport()
...
Recorded SAP Script here
i = 10
do
session.FindById("wnd[0]").Maximize
session.FindById("wnd[0]/tbar[0]/okcd").Text = "/nFBL1N"
...
session.FindById("wnd[1]/tbar[0]/btn[11]").Press
i = i + 1
Vendor = ActiveWorkbook.ActiveSheet.Range("A" & cstr(i))
CoCo = ActiveWorkbook.ActiveSheet.Range("B" & cstr(i))
loop until Vendor = ""
MsgBox "Script Completed."
End Sub
Regards, ScriptMan

You should split the code in a routine that iterates over the configuration and one that takes as input vendor and CoCo and creates the report.
Furthermore I suggest to format your configuration (A9:B12) as a table (Ribbon: Insert > table) then you can use the listobject in VBA - which is much easier to handle regarding ranges etc. I named the table "tblSAPReports".
Option Explicit
Sub createAllReports()
Dim lo As ListObject
Set lo = ThisWorkbook.Worksheets("Table1").ListObjects("tblSAPReports") 'adjust to your needs
Dim lr As ListRow
Dim Vendor As String, CoCo As String
For Each lr In lo.ListRows
Vendor = lr.Range(1, 1): CoCo = lr.Range(1, 2)
SAPCustomerReport Vendor, CoCo
Next
End Sub
Public Sub SAPCustomerReport(Vendor As String, CoCo As String)
'your code
'but remove Vendor and CoCo variable and the setting of the variables
End Sub

Related

Copy / paste dynamic named range from Excel to SAP with VBA

I'm trying to copy a dynamic (named) range of cells from Excel to SAP with the help of a VBA script (manually this would be done through a copy / paste from a clipboard ). The range of values from Excel need to be copied into the multiple selection window of SAP.
But unfortunately it doesn't work and I don't know how to solve it.
This is where I get an error.
Vendors = Sheets("vendors").Range("UniqueVendors").Value
Can anyone help me with this?
Please see here below the code I'm using:
Public SapGuiAuto, WScript, msgcol
Public objGui As GuiApplication
Public objConn As GuiConnection
Public session As GuiSession
Sub SAPDownloadReport()
Set SapGuiAuto = GetObject("SAPGUI")
Set objGui = SapGuiAuto.GetScriptingEngine
Set objConn = objGui.Children(0)
Set session = objConn.Children(0)
Dim CompanyCode As String
Dim ClearingStartDate As Date
Dim ClearingEndDate As Date
Dim SAPLayout As String
Dim FolderPath As String
Dim Filename As String
Dim Vendors As Integer
CompanyCode = Sheets("report").Range("B2").Value
ClearingStartDate = Sheets("report").Range("B3").Value
ClearingEndDate = Sheets("report").Range("B4").Value
SAPLayout = Sheets("report").Range("B5").Value
FolderPath = Sheets("report").Range("B6").Value
Vendors = Sheets("vendors").Range("UniqueVendors").Value
'Insert your SAP Script here
session.FindById("wnd[0]").maximize
session.FindById("wnd[0]/tbar[0]/okcd").Text = "/nFBL1N"
session.FindById("wnd[0]").sendVKey 0
session.FindById("wnd[0]/usr/btn%_KD_LIFNR_%_APP_%-VALU_PUSH").press
session.FindById("wnd[1]/usr/tabsTAB_STRIP/tabpSIVA/ssubSCREEN_HEADER:SAPLALDB:3010/tblSAPLALDBSINGLE/ctxtRSCSEL_255-SLOW_I[1,0]").Text = Vendors
session.FindById("wnd[1]").sendVKey 0
session.FindById("wnd[1]/tbar[0]/btn[8]").press
session.FindById("wnd[0]/usr/radX_CLSEL").Select
session.FindById("wnd[0]/usr/ctxtKD_BUKRS-LOW").Text = CompanyCode
session.FindById("wnd[0]/usr/ctxtSO_AUGDT-LOW").SetFocus
session.FindById("wnd[0]/usr/ctxtSO_AUGDT-LOW").caretPosition = 0
session.FindById("wnd[0]").sendVKey 4
session.FindById("wnd[1]/usr/cntlCONTAINER/shellcont/shell").focusDate = ClearingStartDate
session.FindById("wnd[1]/usr/cntlCONTAINER/shellcont/shell").selectionInterval = "20211001,20211001"
session.FindById("wnd[0]/usr/ctxtSO_AUGDT-HIGH").SetFocus
session.FindById("wnd[0]/usr/ctxtSO_AUGDT-HIGH").caretPosition = 0
session.FindById("wnd[0]").sendVKey 4
session.FindById("wnd[1]/usr/cntlCONTAINER/shellcont/shell").focusDate = ClearingEndDate
session.FindById("wnd[1]/usr/cntlCONTAINER/shellcont/shell").selectionInterval = "20211105,20211105"
session.FindById("wnd[0]/usr/ctxtPA_VARI").Text = SAPLayout
session.FindById("wnd[0]/usr/ctxtPA_VARI").SetFocus
session.FindById("wnd[0]/usr/ctxtPA_VARI").caretPosition = 12
session.FindById("wnd[0]/tbar[1]/btn[8]").press
session.FindById("wnd[0]/mbar/menu[0]/menu[3]/menu[1]").Select
session.FindById("wnd[1]/usr/ctxtDY_PATH").Text = FolderPath
session.FindById("wnd[1]/usr/ctxtDY_FILENAME").Text = "EXPORT.XLSX"
session.FindById("wnd[1]/usr/ctxtDY_FILENAME").caretPosition = 5
session.FindById("wnd[1]/tbar[0]/btn[11]").press
MsgBox "Extraction done"
End Sub
(Maybe copying a Named Range isn't the solution maybe copying the Clipboard from Excel or something different is?)
If the Excel data is in the clipboard with the .Copy command, it can be pasted into SAP as follows:
...
session.findById("wnd[0]/usr/btn%_KD_LIFNR_%_APP_%-VALU_PUSH").press
session.findById("wnd[1]/tbar[0]/btn[24]").press
session.findById("wnd[1]/tbar[0]/btn[8]").press
...
Regards, ScriptMan
Don't know the SAP part but instead of copying you are trying to assign your range to an integer. Replace your "vendors = .." line with:
Sheets("vendors").Range("UniqueVendors").Copy
So no need to assign to anything.

Avaya to VBA - Timezone

Right now i am working on a new project where i have to automatize a dashboard.
This dashboard is getting information from avaya scripts.
I searched for the last 2 weeks a script in VBA that actually gets info from avaya reports and imports them to excel file in a certain sheet.
Well, my problem is that i have to export 1 report with 6 different timezones.
For example:
Historical\Designer\Multi Date Multi Split Skill interval - Europe/Brussels timezone
Historical\Designer\Multi Date Multi Split Skill interval - US/Eastern
etc.
Below is my VBA code that works with my cms but it does not take in account that my timezone is set as Europe/Brussels and it exports in default timezone.
Please, help me out so i can ease my work with few hours a week :)
Thank you guys
Sub EMEA()
Dim cvsApp As Object
Dim cvsConn As Object
Dim cvsSrv As Object
Dim Rep As Object
Dim Info As Object, Log As Object, b As Object
Dim CMSRunning As String
Dim objWMIcimv2 As Object
Dim objProcess As Object
Dim objList As Object
CMSRunning = "acsSRV.exe"
Set objWMIcimv2 = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\.\root\cimv2") 'Connect to CIMV2 Namespace
Set objList = objWMIcimv2.ExecQuery _
("select * from win32_process where name='" & CMSRunning & "'") 'determine if CMS is running
If objList.Count = 0 Then 'If 0 then process isn't running
End If
Set cvsApp = CreateObject("ACSUP.cvsApplication")
Set cvsConn = CreateObject("ACSCN.cvsConnection")
Set cvsSrv = CreateObject("ACSUPSRV.cvsServer")
Set Rep = CreateObject("ACSREP.cvsReport")
Application.ScreenUpdating = 0
Set cvsSrv = cvsApp.Servers(1)
Application.ScreenUpdating = 1
AgGrp = InputBox("Enter Agent Group Name", "Agent Group", "952;953;271;270;221;222;223;224;231;233;232;234;235;246;241;243;242;247;249;245;244;248;255;258;256;259;257;261;262;260") 'change as needed for variables to enter into report
RpDate = InputBox("Enter Date", "Date", "-1") 'change as needed for variables to enter into report
'Start code from CMS Export script
On Error Resume Next
cvsSrv.Reports.ACD = 1
Set Info = cvsSrv.Reports.Reports("Historical\Designer\Multi Date Multi Split Skill interval")
b = cvsSrv.Reports.CreateReport(Info, Rep)
If b Then
Rep.Window.Top = 1830
Rep.Window.Left = 975
Rep.Window.Width = 17610
Rep.Window.Height = 11910
Rep.SetProperty "Splits/Skills", AgGrp 'change as needed for report variables
Rep.SetProperty "Dates", RpDate 'change as needed for report variables
Rep.SetProperty "Times", "00:00-23:30"
Rep.TimeZone = "Europe/Brussels"
b = Rep.ExportData("", 9, 0, True, True, True)
Rep.Quit
If Not cvsSrv.Interactive Then cvsSrv.ActiveTasks.Remove Rep.TaskID
Set Rep = Nothing
End If
Set Info = Nothing
' End code from CMS Export Script
cvsConn.logout
cvsConn.Disconnect
cvsSrv.Connected = False
Set Log = Nothing
Set Rep = Nothing
Set cvsSrv = Nothing
Set cvsConn = Nothing
Set cvsApp = Nothing
Set Info = Nothing
Range("A1").Select
ActiveSheet.Paste
End Sub

How to create a workbook array dynamically in VBA

I am trying to add workbook objects to an array of workbooks
The array is of type public created in a separate module
Option Explicit
Public w() As Workbook
Public i As Integer
then i have the below procedure in a sub stored in a worksheet
Sub test_addwbobjects()
ReDim Preserve w(2)
Application.Workbooks("Quick analysis - Moneycontrol.xlsx").Activate
Set w(i) = ActiveWorkbook
'Set w(i) = Application.Workbooks("Quick analysis - Moneycontrol.xlsx")
i = i + 1
'ActiveSheet.Range("b2") = w(0).Sheets("CF analysis").Range("b2")
'ActiveSheet.Cells(1, 1) = w(i).Sheets("CF analysis").Range("b2")
'ActiveSheet.Range("b2") = w(1).Sheets("CF analysis").Range("b5")
End Sub
Context:
The workbook "Quick analysis - Moneycontrol.xlsx" contains a financial model of a company. I want to be able to compare financial information of multiple companies, so for that purpose I want to create a workbook object every time I paste a company's financials into the "Quick analysis - Moneycontrol.xlsx" workbook
I am currently getting the subscript out of range error.
Can anyone help me with this?
Thanks
Maybe this will help:
Public w As Collection
Sub Test_addWBObject()
Set w = New Collection
w.Add Item:=Workbooks("Quick analysis - Moneycontrol.xlsx"), _
Key:="MyUniqueKeyForThisWorkbook"
'Can use collection as this:
ThisWorkbook.Worksheets("Sheet1").Range("A1") = w(1).Worksheets("Sheet1").Range("C2")
'or this
ThisWorkbook.Worksheets("Sheet1").Range("A1") = w("MyUniqueKeyForThisWorkbook").Worksheets("Sheet1").Range("C2")
'or this
Dim wrkBk As Variant
For Each wrkBk In w
ThisWorkbook.Worksheets("Sheet1").Range("A1") = wrkBk.Worksheets("Sheet1").Range("C2")
Next wrkBk
'or this
Dim x As Long
For x = 1 To w.Count
ThisWorkbook.Worksheets("Sheet1").Range("A1") = w(x).Worksheets("Sheet1").Range("C2")
Next x
End Sub

VBA module call in userform to diff sheets

new and would like to ask if someone could possibly check my code to see where i'm making a mistake.
first, i've created a form with two textboxes and two buttons that will go and get two different directories and the associated files. this is done through a call to a function that loads the dir to the textboxes.
a button to call a function to navigate dir and get the file
Private Sub CommandButton3_Click()
'call selectFile function to select file
selectFile
End Sub
function to get workbooks into textboxes 1 and 2:
Public Function selectFile()
Dim fileNamePath1 As String
Dim fileNamePath2 As String
Dim workbookFilePath1 As String
Dim workbookFilePath2 As String
On Error GoTo exit_
If workbookFilePath1 = Empty And workbookFilePath2 = Empty Then
fileNamePath1 = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Open Workbook 1", MultiSelect:=False)
workbookFilePath1 = Dir(fileNamePath1)
'TextBox1.Text = workbookFilePath1
TextBox1.Value = fileNamePath1
fileNamePath2 = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Open Workbook 2", MultiSelect:=False)
workbookFilePath2 = Dir(fileNamePath2)
TextBox2.Value = fileNamePath2
If fileNamePath1 = False Or fileNamePath2 = False Then
MsgBox ("File selection was canceled.")
Exit Function
End If
End If
exit_:
End Function
up to here, the code is ok... can do better, but
here's where problems occur... i'd like to pass the directories as objects into the module to diff
button that executes module to diff:
Private Sub CommandButton1_Click()
getTheWorkbooksToCompare(fileNamePath1, fileNamePath2)
End Sub
i know that i've changed myPath1 and myPath2 to Workbooks, where I've had them as strings before
diffing module
Public Sub gettheWorkbooksToCompare(myPath1 As Workbook, myPath2 As Workbook)
Dim myExcelObj
Dim WorkbookObj1
Dim WorkbookObj2
Dim WorksheetObj1
Dim WorksheetObj2
Dim file1 As String
Dim file2 As String
Dim myWorksheetCounter As Integer
Dim i As Worksheet
Set myExcelObj = CreateObject("Excel.Application")
myExcelObj.Visible = True
Set file1 = Dir(myPath1)
Set file2 = Dir(myPath2)
Set WorkbookObj1 = myExcelObj.Workbooks.Open(file1)
Set WorkbookObj2 = myExcelObj.Workbooks.Open(file2)
Set NewWorkbook = myExcelObj.Workbooks.Add
While WorkbookObj1 <> Null And WorkbookObj2 <> Null
'While WorkbookObj1.ActiveWorkbook.Worksheets.count = WorkbookOjb2.ActiveWorkbook.Worksheets.count
myWorksheetCounter = ActiveWorkbook.Worksheets.count
myWorksheetCount = ActiveWorkbook.Worksheets.count
If WorksheetObj1.Worksheets.myWorksheetCounter = WorkbookObj2.Worksheets.myWorksheetCounter Then
Set WorksheetObj1 = WorkbookObj1.Worksheets(myWorksheetCounter)
Set WorksheetObj2 = WorkbookObj2.Worksheets(myWorksheetCounter)
Set myNewWorksheetObj = NewWorkbook.Worksheets(myWorksheetCounter)
For myWorksheetCounter = i To WorksheetObj1
For myWorksheetCount = j To WorksheetOjb2
'If cell.Value myWorksheetObj2.Range(cell.Address).Value Then
If cell.Value = myWorksheetObj2.Range(cell.address).Value Then
myNewWorksheetObj.Range(cell.address).Value = cell.address.Value
myNewWorksheetObj.Range(cell.address).Interior.ColorIndex = 3
Else
cell.Interior.ColorIndex = 0
End If
Next
'if doesn't work... use SaveChanges = True
myNewWorksheetObj.Workbooks.Save() = True
Next
Else
MsgBox ("The worksheets are not the same worksheets." & vbNewLine & "Please try again.")
End If
Wend
Set myExcelObj = Nothing
End Sub
So my question is... can someone please assist in seeing where i'm going wrong? essentially, i'm having some issues in trying to get this working.
much appreciated
i've gone through and cleaned up some areas a little bit... but now have a: "run time error '438': object doesn't support this propety or method" at the while loop code that i've updated the post with
I see a typo on CommandButton1_Click
Private Sub CommandButton1_Click()
getTheWorkbooksToCompare(fileNamePath1, fileNamePath2)
End Sub
Public Sub gettheWorkbooksToCompare(myPath1 As Workbook, myPath2 As Workbook)
There might be something more, but your not capitalizing the "T" in getThe, but you call it that way.

Userform combobox not populating on initialize

I have a user form with three comboboxes and one text box that I would like to populate with named ranges or public variables. I am working in Excel 2010 on Windows. Here is what I have:
First I run through some code that converts one worksheet into a new configuration. I then call the userform which will set up the variables necessary to update the worksheet further. I have done this on a Mac and it works, but I am transitioning this from the mac to a windows server. I thought this would be the easy part but it in not working for some reason.
Here is the code for the userform.
Public KorS As String
Public ActivityID As String
Public Stage As String
Public varsaveme As String
Private Sub ufStageDt_Initialize()
AD = varsaveme & ".xls"
duh = KorS
Set Me.tbAdName.Text = duh
Set UserForm1.Caption = AD
'Set Me.cmbLowDt.List = "AnnDt"
Set Me.cmbHighDt.List = "AnnDt"
Set Me.cmbStage.List = "Stage"
Me.cmbLowDt.List = "AnnDt"
End Sub
The public variables are present in the code on the worksheet.
Here is the code that I used on the Mac.
Private Sub UserForm_Initialize()
Ad = varsaveme & ".xls"
duh = KorS
tbAdName.Text = varsaveme
UserForm.Caption = Ad
cmbLowDt.List = Range("AnnDt").Value
cmbHighDt.List = Range("AnnDt").Value
cmbStage.List = Range("Stage").Text
End Sub
Any assistance would be greatly appreciated. I am using the ufStageDt.Show command in the vba script to bring up the userform.
Set won't work, so eliminate that. Also, List expects an array. For a single hard-coded item, use Additem.
Me.cmbHighDt.Additem "AnnDt"
EDIT: "AnnDt" is a named range:
Me.cmbHighDt.List = Application.Transpose(ActiveSheet.Range("AnnDt"))
EDIT2: For dates:
Private Sub UserForm_Initialize()
Dim i As Long
With Me.cmbHighDt
.List = Application.Transpose(ActiveSheet.Range("AnnDt"))
For i = 0 To .ListCount - 1
.List(i) = Format(.List(i), "yyyy-mm-dd")
Next i
'to get it back to a date
ActiveSheet.Range("B1") = DateValue(.List(0))
End With
End Sub

Resources