How to handle intermittent pop-up window - vba

The goal of this macro is to add the correct value of the carriage in the Billing Notes of each one of the orders from a column of the input Excel file.
The expected result is a smooth run. The actual result is that the script runs fine up until it works on an order which shows the pop up window Not Optimized container after saving changes. Run-time error 619: The control could not be found by id is the error message.
This script is looped. Based on the location of the error, I assume the script is trying to run the loop again, but as this pop-up window is in the middle of the screen it can't advance.
I have tried Errhandler, On Error GoTo, On Error Resume Next in the final line of the code before Range ("E" & i) = "uploaded" but the script will always stop on the line when the pop-up does not appear.
Here is my code, in bold the lines I believe would solve the pop-up issue. I do not know, nor can I apply a strategy, that would allow the macro to ignore this line if the pop-up does not appear.
So, in short, how do I make the script ignore this line if the no optimized container does not show, and execute the click on Yes if it does?
I have checked https://answers.sap.com/questions/3285089/check-for-popup-within-script.html.
'step 2 - VA02
Dim concat As String
concat = Range("D2")
Dim cell As String
Dim i As String
i = 2
cell = Range("B" & i)
concat = Range("D" & i)
session.FindById("wnd[0]").maximize
session.FindById("wnd[0]/tbar[0]/btn[15]").press
session.FindById("wnd[0]/tbar[0]/btn[15]").press
session.FindById("wnd[0]/tbar[0]/okcd").Text = "VA02"
session.FindById("wnd[0]").sendVKey 0
Do While cell <> ""
cell = Range("B" & i)
concat = Range("D" & i)
session.FindById("wnd[0]/usr/ctxtVBAK-VBELN").Text = cell
session.FindById("wnd[0]").sendVKey 0
session.FindById("wnd[0]").sendVKey 0
**'session.findById("wnd[1]/tbar[0]/btn[0]").press**
session.FindById("wnd[0]/usr/subSUBSCREEN_HEADER:SAPMV45A:4021/btnBT_HEAD").press
session.FindById("wnd[0]/usr/tabsTAXI_TABSTRIP_HEAD/tabpT\10").Select
session.FindById("wnd[0]/usr/tabsTAXI_TABSTRIP_HEAD/tabpT\10/ssubSUBSCREEN_BODY:SAPMV45A:4152/subSUBSCREEN_TEXT:SAPLV70T:2100/cntlSPLITTER_CONTAINER/shellcont/shellcont/shell/shellcont[0]/shell").selectItem "ZZ05", "Column1"
session.FindById("wnd[0]/usr/tabsTAXI_TABSTRIP_HEAD/tabpT\10/ssubSUBSCREEN_BODY:SAPMV45A:4152/subSUBSCREEN_TEXT:SAPLV70T:2100/cntlSPLITTER_CONTAINER/shellcont/shellcont/shell/shellcont[0]/shell").ensureVisibleHorizontalItem "ZZ05", "Column1"
session.FindById("wnd[0]/usr/tabsTAXI_TABSTRIP_HEAD/tabpT\10/ssubSUBSCREEN_BODY:SAPMV45A:4152/subSUBSCREEN_TEXT:SAPLV70T:2100/cntlSPLITTER_CONTAINER/shellcont/shellcont/shell/shellcont[0]/shell").doubleClickItem "ZZ05", "Column1"
session.FindById("wnd[0]/usr/tabsTAXI_TABSTRIP_HEAD/tabpT\10/ssubSUBSCREEN_BODY:SAPMV45A:4152/subSUBSCREEN_TEXT:SAPLV70T:2100/cntlSPLITTER_CONTAINER/shellcont/shellcont/shell/shellcont[1]/shell").setSelectionIndexes 0, 100
session.FindById("wnd[0]/usr/tabsTAXI_TABSTRIP_HEAD/tabpT\10/ssubSUBSCREEN_BODY:SAPMV45A:4152/subSUBSCREEN_TEXT:SAPLV70T:2100/btnTP_DELETE").press
session.FindById("wnd[0]/usr/tabsTAXI_TABSTRIP_HEAD/tabpT\10/ssubSUBSCREEN_BODY:SAPMV45A:4152/subSUBSCREEN_TEXT:SAPLV70T:2100/cntlSPLITTER_CONTAINER/shellcont/shellcont/shell/shellcont[1]/shell").Text = concat
session.FindById("wnd[0]/usr/tabsTAXI_TABSTRIP_HEAD/tabpT\10/ssubSUBSCREEN_BODY:SAPMV45A:4152/subSUBSCREEN_TEXT:SAPLV70T:2100/cntlSPLITTER_CONTAINER/shellcont/shellcont/shell/shellcont[1]/shell").setSelectionIndexes 47, 47
session.FindById("wnd[0]/tbar[0]/btn[11]").press
**'session.findById("wnd[1]/usr/btnZSPOP_PRIMARY-OPTION1").press**
Range("E" & i) = "uploaded"
i = i + 1
Loop
MsgBox ("Done")
End Sub

This will check if the pop up appears or not.
If session.ActiveWindow.Name = "wnd[1]" Then
session.findById("wnd[1]/usr/btnZSPOP_PRIMARY-OPTION1").press
End If

Related

Having trouble copying data from one sheet to another

Developing a large macro and now it seems the second simplest part is giving me trouble.
I am able to copy the selection in one workbook, but it does not allow me to paste over to the other workbook. I am getting:
"Object doesn't support this property or method" error.
This is looping through large sets of data so it will need to be able to rinse and repeat, which shouldn't be a problem because I can just clear the clipboard as a rinse method.
Any ideas?
Code below. There is code above it, but I don't think you should need any of it to get an idea of what's going on. Error comes in on the ** line.
Do
DoEvents
'Tests condition for counter party
If InStr(1, Range(buyerCol & row_counter), clientName) > 0 Or InStr(1, Range(sellerCol & row_counter), clientName) > 0 Then
EEB.Sheets("Trades Master List").Rows(row_counter).Copy
'Activates newly created excel sheet
Workbooks(newWorkbookName).Activate
'Tests newly created sheet for already existing entries and increments newSheetRow by 1 until it finds the next empty space
Do While IsEmpty(Range("A" & newSheetRow)) = False
newSheetRow = newSheetRow + 1
Loop
**ActiveWorkbook.Range(newSheetRow & newSheetRow).PasteSpecial
EEB.masterList.Activate
row_counter = row_counter + 1
Else
row_counter = row_counter + 1
End If
Loop Until Range("A" & row_counter).Value > endDateFromSheet Or IsEmpty(Range("A" & row_counter)) = True

'Exit For' is not working

Doing a reverse for loop in Excel VBA, looking for the last populated cell in a certain column. Once found, it should exit the loop, but Exit For is not working, and continues looping all the way back. Any ideas?
rewind:
' so we 're still "under", rollback to the right line
While Not Range("I" & a).Value = getsum
a = a - 1
On Error GoTo TryCatch
If Not Range("E" & a).Value = "" Then
Rows(a).Select
currfield = Range("E" & a).Value
runningstrsum = runningstrsum - currentstrsum 'we're switching streets
' and since we just lost currentstrsum, we have to reset it to the last one, yay
For c = a - 1 To 2 Step -1
If Not Range("E" & c).Value = "" Then 'there it is
currentstrsum = Range("E" & c).Value
Exit For
End If
Next c
End If
Wend
If overunder < 0 Then 'go back to overunder<
GoTo goodjobunder
ElseIf overunder = 0 Then
GoTo goodjobeven
End If
You're only exiting the inner loop, the code will resume outside of this loop - which is still inside the While loop and therefore re-enter the For loop.
If you want to find the last populated cell in a column just use something like:
Dim lastCell As Excel.Range
Set lastCell = Range("E" & Rows.Count).End(xlUp)
No need to loop.
Might also be a good time to look at Debugging VBA Code

excel hyperlink to nothing

I've got a lot of hyperlinks and I want to assign a macros to each of them and Worksheet_FollowHyperlink captures only Inserted Hyperlinks but not the HYPERLINK() function. So I want my Inserted Hyperlinks refer to nothing so when I press them nothing happens. Or I want them to refer themselves. But when I just copy one to another cell it still refers to its parents cell. So I have to edit a new one so it refers to its new cell. And I've got hundreeds of hyperlinks to be copied and edited as well. I need that because I don't want the hyperlinks skip me to the parent hyperlink's cell.
Thanks in advance
You will be better off using the HYPERLINK() function. You can use it for what you want like this:
=HYPERLINK("#HyperlinkClick()", "Text you want to Display")
Notice the # at the beginning. This is important.
Now create a function called HyperlinkClick:
Function HyperlinkClick()
Set HyperlinkClick = Selection
'Do whatever you like here...
MsgBox "You clicked on cell " & Selection.Address(0, 0)
End Function
Be sure to place this function in a STANDARD CODE MODULE.
That's it.
I've just founded a solution. If I refer my Inserted Hyperlink to some cell in other sheet and then make it very hidden (xlSheetVeryHidden), it works just perfect. Now my hyperlinks refer to the Neverland and the macro captures them as well. Thank you all for your patiense.
Good solution Excel Hero but not for everything: I try to make a kind of outline but it's impossible to hide a row in the function: nothing happen! But if a make a direct call to the same code with a button, everything works fine. This is my test:
Function test()
Set test = Selection
Dim i, j, state As Integer
state = Selection.Value
i = Selection.Row + 1
j = i
If state = "6" Then
Do Until ActiveSheet.Cells(j, 7).Value = 1 Or ActiveSheet.Cells(j, 4).Value = ""
j = j + 1
Loop
ActiveSheet.Rows(i & ":" & j - 1).EntireRow.Hidden = True
Debug.Print "test group: " & i & ":" & j - 1
Else
Do Until ActiveSheet.Cells(j, 7).Value = 1 Or ActiveSheet.Cells(j, 4).Value = ""
j = j + 1
Loop
ActiveSheet.Rows(i & ":" & j - 1).EntireRow.Hidden = False
Debug.Print "test ungroup: " & i & ":" & j - 1
End If
End Function
My debug.print give me this:
test group: 4:26
Select a group of cells and run:
Sub HyperAdder()
For Each r In Selection
ActiveSheet.Hyperlinks.Add Anchor:=r, Address:="", SubAddress:=r.Parent.Name & "!" & r.Address(0, 0), TextToDisplay:="myself"
Next r
End Sub

Stuck with a loop. After it fulfilled its function it keeps on going

The first code is there to see if the number 20 is already in the spaces B28 till B47. If that is the case, I want it to move on to the next step. If the number 20 is not there, then i would like it to add the number to line B47 and then end after completing that. I'm haing problems trying to get it to stop after it added the number 20. Instead of ending, it continues down the column and adds een more 20s due to it not finidng any. What I have been trying to create is a loop which checks all the cells first, and if it does not find 20 it adds it once, instead of adding it 20 times.
The second code I hae after this is there to try to delete all empty rows in B28 till B47. However, it does not do that and skips this loop entirely moving to Blargh3 instead. I have tried creating loops for this, but Excel has always been giving me an error with it. I have tried researching as to how I could fix it after i have tried myself. I was not able to find anything which helped me.
As I am quite new to VBA, help would be greatly appreciated.
For Each Cell In Worksheets("Sheet1").Range("B28:B48")
If Cell.Value > 19 Then
GoTo Blargh2
Else:
Range("B" & 47, "BM" & 47).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B" & 47) = 20
Dim a As Long
For a = 3 To 65
Cells(47, a) = 3
Next
End If
Next
Blargh2:
For Each Cell In Worksheets("Sheet1").Range("B28:B47")
If Cell.Value = 0 Then
Row.Delete X1DeleteShiftUp
Else:
GoTo Blargh3
End If
Next
Blargh3:
Dim i As Long
For i = 47 To 29 Step -1
If Range("B" & i) - Range("B" & i).Offset(-1, 0) > 1 Then
Range("B" & i, "BM" & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B" & i) = Range("B" & i).Offset(1, 0) - 1
Dim c As Long
For c = 3 To 65
Cells(i, c) = 3
Next
i = i + 1
End If
Next
Turn on your Immediate Window -> ctrl+g or in the menu bar click View => Immediate Window
This would be the first part based on your logic
Sub FirstPart()
Dim is20There As Range
With Range("B28:B47")
Set is20There = .Find(What:="20", LookIn:=xlValues, lookat:=xlPart)
End With
If is20There Is Nothing Then
Debug.Print "20 is not there, executing your code now"
Range("B" & 47, "BM" & 47).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B" & 47) = 20
Dim a As Long
For a = 3 To 65
Cells(47, a) = 3
Next
Else
Debug.Print "exiting because 20 is there"
End If
End Sub
What happens here in the first loop is
using the .Find function in range B28:B47 to find the value of 20. If the value is there then the Else part of the loop will execute which simply does nothing but prints a message to the Immediate Window that 20 has been found.
this is when the 20 is not there
If 20 is not found (If is20There is Nothing evaluates to True) then you can execute your code which I guess adds a row at B47 (shifting the last row down ) and fills the cells with number 3 all the way down to 65th column except the B column which you seem to assign number 20 to.
So if 20 is not there the code literally does nothing.
this is when 20 is there (nothing happens)
The second part loops through B28:B47 backwards ( starting form the end to beginning ) and deletes the entire rows if any of them are empty ( column B only )
this is before
then run the code
Sub SecondPart()
Dim i As Long
Dim cell As Range
For i = 47 To 28 Step -1
Set cell = Range("B" & i)
If IsEmpty(cell) Then
Rows(cell.Row & ":" & cell.Row).Delete shift:=xlUp
End If
Next i
End Sub
and this is after

Speed up excel formatting vba code?

I am using the following vba code to change a text string date into an actual date in excel so I can use it for logical comparisons and the like.
The problem is I need this to work for around 4000 rows and update it weekly, and this code is very slow.
Sub Datechange()
Dim c As Range
For Each c In Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row)
c.Value = CDate(c.Value)
Next c
End Sub
Are there any alternative ways I could do the same thing quicker? I am assuming part of the reason it is so slow is because there are overheads involved with selecting single cells and processing the code over and over but I am not sure how to do it any other way?
Also some of the rows at the bottom contain the words "None Specified" and when the code reaches these cells it breaks with
Run-time error '13': Type mismatch
Is there a way to stop this happening so the following code can complete?
First steps would be:
Turn screen updating off
Turn calculation off
Read and write the range at once
It could look like the code below - it is a good idea to include an error handler to avoid leaving your spreadsheet with screen updates off or with the calculation mode changed:
Sub Datechange()
On Error GoTo error_handler
Dim initialMode As Long
initialMode = Application.Calculation 'save calculation mode
Application.Calculation = xlCalculationManual 'turn calculation to manual
Application.ScreenUpdating = False 'turn off screen updating
Dim data As Variant
Dim i As Long
'copy range to an array
data = Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row)
For i = LBound(data, 1) To UBound(data, 1)
'modify the array if the value looks like a date, else skip it
If IsDate(data(i, 1)) Then data(i, 1) = CDate(data(i, 1))
Next i
'copy array back to range
Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row) = data
exit_door:
Application.ScreenUpdating = True 'turn screen updating on
Application.Calculation = initialMode 'restore original calculation mode
Exit Sub
error_handler:
'if there is an error, let the user know
MsgBox "Error encountered on line " & i + 1 & ": " & Err.Description
Resume exit_door 'don't forget the exit door to restore the calculation mode
End Sub
It would be better to get the values in to an array in one single "pull", operate on the array and write it back.
That would circumvent the expensive range operation.
dim c as range
set c = Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row)
dim ArrValue() as Variant
set ArrValue = c.value
next step: iterate over that array and then write back:
c.value = Arrvalue
I have no time to test the code, so please correct it for yourself, I am sorry.