Situation
I have created a lookup functionality for SAP GUI scripting.
If a grid row has specific values in specific columns, then it is double clicked (this triggers loading specific dependent data).
My grid has less than 300 rows, so loading so much data shouldn't strain a modern computer.
Issue
The issue I have is that from SAPGrid Row 64 it returns "" for each cell. If I enter debugging and scroll down in the ALV grid then the grid row loads and the results are found.
Possible solutions
Can I change how many rows are loaded on default?
Is there a method for pulling the full recordset?
The alternative options include scrolling up and down using scripting or setting up filters.
Code
Sub FindGridLine(SAPGrid As Object, criteria() As String)
SAPGrid.ClearSelection 'first it deselects what has been selected
For k = 0 To (SAPGrid.RowCount - 1) 'for each grid row
For i = 1 To UBound(criteria, 1) ' for each criteria row except for the first (should be only 1)
For j = LBound(criteria, 2) To UBound(criteria, 2) 'and for each column
tempstr = SAPGrid.GetCellValue(k, criteria(0, j))
If tempstr <> criteria(i, j) Then 'if the criterion doesn't match
GoTo nextrow 'then go to the next row
End If
Next j
Next i
'if it passed the criteria then doubleclick it
SAPGrid.DoubleClick k, criteria(0, 0)
Exit Sub
nextrow:
Next k
'in case no results were found
MsgBox "No line was found in grid!"
End Sub
Updated code
Code updated based on correct answer from #Asger.
Since lookups mostly work with primary keys, I went for the safe solution of SAPGrid.GetCellValue(k, criteria(0, j)) = "" but the solution is in fact SAPGrid.SetCurrentCell k, criteria(0, j).
Sub FindGridLine(SAPGrid As Object, criteria() As String)
' SAPGrid.SelectAll 'first it selects everything as to load the full grid
SAPGrid.ClearSelection 'first it deselects what has been selected
For k = 0 To (SAPGrid.RowCount - 1) 'for each grid row
For i = 1 To UBound(criteria, 1) ' for each criteria row except for the first (should be only 1)
For j = LBound(criteria, 2) To UBound(criteria, 2) 'and for each column
tempstr = SAPGrid.GetCellValue(k, criteria(0, j))
If tempstr = "" Then SAPGrid.SetCurrentCell k, criteria(0, j) 'this solution only works if the search is done in a non-empty field
tempstr = SAPGrid.GetCellValue(k, criteria(0, j))
If tempstr <> criteria(i, j) Then 'if the criterion doesn't match
GoTo nextrow 'then go to the next row
End If
Next j
Next i
'if it passed the criteria then doubleclick it
SAPGrid.DoubleClick k, criteria(0, 0)
Exit Sub
nextrow:
Next k
'in case no results were found
For i = 0 To UBound(criteria, 1) ' for each criteria row except for the first (should be only 1)
For j = LBound(criteria, 2) To UBound(criteria, 2) 'and for each column
tempstr = tempstr & "|" & criteria(i, j)
Next j
If i <> UBound(criteria, 1) Then
tempstr = tempstr & vbNewLine
End If
Next i
MsgBox "No line was found in grid!" & vbNewLine & "Please select line" & tempstr & vbNewLine & "manually and press 'OK'" & vbNewLine & "or enter debug mode."
End Sub
GuiGridView / ALV Grid Control: For large amounts of data, reloading of the content takes place only after scrolling, otherwise it is likely that only one empty string will be returned as the result - even without causing an exception.
Therefore SetCurrentCell should always be used to focus and load the dataset to be read.
Please test e. g. SAPGrid.SetCurrentCell(k, 1)
Maybe it's sufficient to load every new 64 rows (I can't test it):
If k Mod 64 = 63 Then ' at least if 1 row before each 64 rows
SAPGrid.SetCurrentCell (k, criteria(0, LBound(criteria, 2)))
End If
Related
At work I have a repetitive task of going through a list of account activity and changes where I have to delete blank spaces and lines that are not necessary for the maintenance I perform. For 80% of the these I am able to work a for each loop that is pretty inelegant but effective.
Example:
For Each c In ActiveSheet.UsedRange
If InStr(1, c.Value, SubString7) = 1 Then ' find earn lines and remove
c.EntireRow.Offset(1).Delete
c.EntireRow.Clear
c.EntireRow.Offset(-1).Delete
End If
Next
The substring is the descriptive title line for each type of transaction. The one I am having trouble with is variable, while the others are not. It can be 9 lines long or 6 lines long, and could also be positive or negative but each possibility comes with the same title line.
Based on everything I could find to try to figure it out, I need to use a loop, moving from bottom to top. I cannot get it to trigger with either InStr, nor left/right.
This is a cut down version of what I am trying now:
lr = Range("A" & Rows.Count).End(xlUp).Row
For rowcounter = lr To 0 Step -1
If VBA.Strings.Left(Cells(rowcounter).Value, 11) Like "Earn Manual" Then
If VBA.Strings.Left(Cells(rowcounter + 5).Value, 1) = "-" Then
If VBA.Strings.Left(Cells(rowcounter + 6).Value, 3) = "AVG" Then
Cells(rowcounter).EntireRow.Offset(5).Delete 'this, several more times with different offsets for the required lines
Else
Cells(rowcounter).EntireRow.Offset(5).Delete 'different ones, finalizing removals on the negative value items
End if
Else
If VBA.Strings.Left(Cells(rowcounter + 6).Value, 3) = "AVG" Then
Cells(rowcounter).EntireRow.Offset(5).Delete 'again, but with different offsets
Else 'There is one line for these that I have to split into two lines, not sure if this will even work as I cannot get it to trigger
Cells(rowcounter).EntireRow.Offset(8).Delete
Cells(rowcounter).EntireRow.Offset(7).Delete
Cells(rowcounter + 4).Value = VBA.Strings.Right(Cells(rowcounter + 3).Value, 25)
Cells(rowcounter + 3).Value = VBA.Strings.Left(Cells(rowcounter + 3).Value, 13)
End if
End If
End If
Next Rowcounter
I had originally had that first If line as:
If InStr(1, Cells(rowcounter).Value, SubString8) = 1 Then
I tried switching to Left() and Like but still no dice.
Attempting to provide sample of input/output
sample data:
Goal output from column A:
Retained Data
Update again, new and improved code that is still failing:
Next
For i = 1 To ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row
If ws.Range("A" & i) Like "Earn Manual*" Then
If ws.c("A" & i + 5) Like "-*" Then
If ws.c("A" & i + 6) Like "Avg*" Then
Set Deleteme = c.Range("A" & i, "A" & i + 8) ' shows AVG, negative value
Else
Set Deleteme = c.Range("A" & i, "A" & i + 5) ' no AVG, negative value
End If
Else
If ws.c("A" & i + 6) Like "Avg*" Then
Set Deleteme = c.Range("A" & i, "A" & i + 3)
Set Deleteme = c.Range("A" & i + 5)
Else
Set Deleteme = c.Range("A" & i, "A" & i + 3)
Set Deleteme = c.Range("A" & i + 5)
End If
End If
Else
Set Deleteme = Union(Deleteme, ws.Range("A" & i))
End If
Next A
There is no way that I can get this 100% correct because it was based of the OP's new and improve code, which has some flaws in its logic. My goal was to simply the overall syntax to make it easier to get right.
The problem with deletion with offset values is that the values move on you. My solution is to Union all rows to be deleted and delete them then after the loop is done. This is not only more efficient but it allows us to loop from top to bottom. This makes the code it much easier to follow.
When Union ranges in this way, you must first test to see if the target range to be deleted is Nothing. If the target range is Nothing, we Set it to the new range else we Union the two ranges. I wrote a subroutine UnionRange(), so that we would not have to repeat this process each time we needed to do a Union.
With blocks, Range.Offset() and Range.Resize() were used to simply the syntax. I feel like this is cleaner than concatenating addresses inside of a range (e.g. Range("A" & i + 5) and Range("A" & i, "A" & i + 8)).
Sub CleanUp()
With ThisWorkbook.Worksheets("Sheet1")
Dim r As Long
Dim rUnion As Range
For r = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
With .Cells(r, 1)
If .Value = "" Then
UnionRange rUnion, .Offset(0)
ElseIf .Value Like "Earn Manual*" Then
If .Offset(6).Value Like "Avg*" Then ' shows AVG, negative value
UnionRange rUnion, .Offset(8)
Else ' no AVG, negative value
UnionRange rUnion, .Offset(5)
End If
Else
'This can't be right
If .Offset(6).Value Like "Avg*" Then 'If Like "Avg*" Then Delete These Cells
UnionRange rUnion, .Resize(3)
UnionRange rUnion, .Offset(5)
Else 'Hell If Not Like "Avg*" Then Delete The Same Cells Anyway
UnionRange rUnion, .Resize(3)
UnionRange rUnion, .Offset(5)
End If
End If
End With
Next
End With
If Not rUnion Is Nothing Then
Application.ScreenUpdating = False
rUnion.EntireRow.Delete
End If
End Sub
Sub UnionRange(ByRef rUnion As Range, ByRef Cell As Range)
If rUnion Is Nothing Then
Set rUnion = Cell
Else
Set rUnion = Union(rUnion, Cell)
End If
End Sub
The excel file for dates of duties taken by persons are as shown in figure. Marked duties as X
How can I get the date of duties taken by a particular person using filtering?
Is there any method to get each person's name together with their duty date in a separate sheet?
I think what you're trying to do is:
Unpivot:
Select the data and on the Insert menu choose Table
On the Data menu click From Table/Range
The query window will open. Choose the columns you need to extract. With your data the columns to highlight are "Type" and "Number of Cases"
On the Tranform menu choose Unpivot Columns
If the data looks right now, close the Query Editor (accepting changes).
Another example:
If your goal is to get from this:
...to this (or that):
...then what you want to do is called an Unpivot.
How to Unpivot "crosstab-style" data:
You can find the steps written out on a question I answered here, and there's a more detailed explanation and steps over here.
Approach via array filtering
You need filter results row wise (e.g. Tessy Paul- 26 April 18, 27 April 18, 30 April 18, 2-May 18), but IMO you won't get them via advanced filter method. Instead I demonstrate an alternative approach using arrays to get the source data (looping through a range via VBA is slow) and to extract the rearranged (=recoded) data via Application.Filter matching items marked by "x" as duty.
Essential steps
First you write all your data to a variant 2-dimensioned datafield array simply by assigning a predefined range reference - see section [2]:
Dim v As Variant ' or simply: Dim v
Dim rng As Range
'set rng = ...
v = rng.Value2 ' or simply: v = rng
Furthermore it's possible to filter an array via Application.Filter with some restrictions:
a) you'll need some further information beyond the isolated cell data and
b) you'll need a 1-dim array.
ad a) In order to identify name and duty date when filtering, just add these information together with a delimiter (e.g. "#", see section [3]).
This allows you to split the filtered data later by looping through each array item - see sections [4] and [5].
ad b) To get a 1-dim array out of a 2-dim array you can extract a row or a column via Application.Index function.
In the example below I assign results to another array called vi.
For example: if you want to extract a row as shown in section 4.1, the second parameter identifies the row number starting from 1, the third argument column number simply obtains 0 :
Then you can apply the Filter function with this newly dimensioned source array and a match string "x#" to get all data defined as Duty by the x character and the chosen delimiter #.
vi = VBA.filter(Application.Index(v, i, 0), "x#", True, False)
Notes:
The match string consists of both characters ("x#"), as "x" alone could be part of a name (e.g. Alexander), too.
As an addition to row wise filtering:
To extract a column see section 5.1, as this needs an additional adjusting via Application.Transpose.
Each extracted row or column array will be written back to a target sheet and shown via Join function in Debug.Print in your immediate window in the Visual Basic Editor (VBE)
Code Example
Option Explicit
Sub DutiesPerName()
' Site: https://stackoverflow.com/questions/50083149/how-can-i-use-advance-filtering-row-wise
' [0] Declare variables
Dim a()
Dim ws As Worksheet, ws2 As Worksheet
Dim rng As Range, i As Long, j As Long, r As Long, c As Long
Dim v, vi, temp
' [1] define sheetname and data range
' 1.0 set worksheet object to memory
Set ws = ThisWorkbook.Worksheets("MyDataSheet") ' << change to your data sheet name
Set ws2 = ThisWorkbook.Worksheets("MyDutySheet") ' << change to your target sheet name
' 1.1 get rows and columns
r = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
c = ws.Range("A1").End(xlToRight).Column
' 1.2 Alternative code line: Set rng = ws.UsedRange
Set rng = ws.Range(ws.Range(ws.Cells(1, 1), ws.Cells(r, c)).Address)
' [2] create a variant 1-based 2-dim datafield array
v = rng.Value2
' [3] CODE duty items by appending "#" plus date and name info
For i = 2 To UBound(v) ' start loop from 2nd row
v(i, 1) = "x#" & v(i, 1) ' mark name captions to get them filtered, too
For j = 3 To UBound(v, 2) ' start inner loop from 3rd column
If v(i, j) = "x" Then ' code found duty items
v(i, j) = v(i, j) & "#" & Format(v(1, j), "dd-mmm-yy") & "#" & v(i, 1) & "#" & j
'Debug.Print "v(" & i & "," & j & ")=""" & v(i, j) & """"
End If
Next j
Next i
' mark date captions with "x#" to get them filterd, too
For j = 3 To UBound(v, 2)
v(1, j) = "x###" & Format(Val(v(1, j)), "dd-mmm-yy")
Next j
' -----------------------
' [4] Duty Dates per Name:
' -----------------------
ws2.Cells.Clear: ws2.Range("A1") = "Name": ws2.Range("B1") = "Duty Dates ..."
For i = 2 To UBound(v, 1) ' start loop from 2nd row
' 4.1 filter redimensioned 1-dim ROW array via "x#"
vi = VBA.filter(Application.Index(v, i, 0), "x#", True, False)
For j = LBound(vi) To UBound(vi)
vi(j) = Split(vi(j), "#")(1) ' extracts date from e.g. "x#15-Jan-19#x#Paul#2"
Next j
' write dates per name into target worksheet ws2
ws2.Range("A1").Offset(i - 1, 0).Resize(1, UBound(vi) + 1) = vi
Debug.Print "Row# " & i & " (" & _
ws2.Range("A1").Offset(i - 1, 0).Resize(1, UBound(vi) + 1).Address & ") 1 Name + " & UBound(vi) & " Dates: " & _
Join(vi, ", ")
Next i
Debug.Print
' -----------------------
' [5] Names per Duty Date:
' -----------------------
ws2.Range("A1").Offset(r + 2, 0) = "Duty Date": ws2.Range("A1").Offset(r + 2, 1) = "Names ..."
For i = 3 To UBound(v, 2) ' start loop from 3rd column
' 5.1 filter redimensioned 1-dim COLUMN array via "x#"
vi = VBA.filter(Application.Transpose(Application.Index(v, 0, i)), "x#", True, False)
For j = LBound(vi) To UBound(vi)
temp = Split(vi(j), "#")
vi(j) = temp(3) ' extracts Name from e.g. "x#15-Jan-19#x#Albert#3"
Next j
' write each names per date into target worksheet ws2
If UBound(vi) > -1 Then
ws2.Range("A1").Offset(r + i, 0).Resize(1, UBound(vi) + 1) = vi
Debug.Print "Col# " & i & " (" & _
ws2.Range("A1").Offset(r + i, 0).Resize(1, UBound(vi) + 1).Address & ") 1 Date + " & UBound(vi) & " Names: " & _
Join(vi, ", ")
End If
Next i
End Sub
I have a simple macro which adds the contents of each row in an excel sheet to a text file, with delimiters in between each cell value. This is done by running a for loop which iterates through each row and at the end of each iteration the values are added to the end of a String variable.
Each ROW can have a lot of characters in it - I have not noticed any issues with that. However, when 1 single cell contains more than 255 characters, the concatenation fails. I am not sure if it is because of String limitations (I don't think that is the case), or if it is the Trim, Join, or Index functions that contains this limitation, or if it something else. Any help in getting some more insight would be appreciated.
The line in question ('R' refers to the row/iteration number):
stringVariable = stringVariable & vbNewLine & Application.Trim(Join(Application.Index(Cells(R, "A").Resize(, 25).Value, 1, 0), "|"))
The error is:
Run-time error '13': Type mismatch
The problem is with the Application.Index. How to debug?
Let's have the active sheet with any values in row 1, all with less than 255 chars. But in one of this cells in row 1, for example in C1, should be the formula:
=REPT("c",255)
Now split the code into parts:
Sub test()
r = 1
v2DArray = Cells(r, "A").Resize(, 25).Value
index1DArray = Application.Index(v2DArray, 1, 0)
joinString = Join(index1DArray, "|")
stringVariable = Application.Trim(joinString)
MsgBox stringVariable
End Sub
This will work until you change the formula to =REPT("c",256). Now it will fail at Application.Index.
Instead of the Application.Index you could do the following:
Sub test2()
r = 1
v2DArray = Cells(r, "A").Resize(, 25).Value
ReDim v1DArray(LBound(v2DArray, 2) To UBound(v2DArray, 2)) As String
For i = LBound(v2DArray, 2) To UBound(v2DArray, 2)
v1DArray(i) = v2DArray(1, i)
Next
joinString = Join(v1DArray, "|")
stringVariable = Application.Trim(joinString)
MsgBox stringVariable
End Sub
After experimenting using different combinations of the already present functions, I found that the macro finishes without issues when Index is not used.
In the end I decided to add the value of each cell to the end of the string, one at a time. Solution:
For i = 1 To numberOfColumns
If i < numberOfColumns Then
stringVariable = stringVariable & Trim(Cells(R, i).Value) & "|"
Else
stringVariable = stringVariable & Trim(Cells(R, i).Value)
End If
Next i
stringVariable = stringVariable & vbNewLine
I am attempting to copy results from another sheet based on the cell values on the active worksheet. i.e loop through every element in array "GWworkStations()" and find a match in column B of "Col List" sheet, and then copy the corresponding values in "C:E" to an array "MatchedEntries" so I can copy them back to the active sheet.
The code is returning empty for "matchedRow", instead of reporting the row number. I am not getting an error.
dim MatchedEntries() as string
dim GWworkStations() as variant
number_of_rows = ActiveSheet.UsedRange.Rows.Count
With ActiveWorkbook.Worksheets("New Sheet")
GWworkStations() = range("B2:B" & number_of_rows)
End With
ReDim MatchedEntries(1 To r) 'Size the array to hold the results.
'for every cell that is not empty in GWworkStations(), search through column B of 'Col List ' sheet.
For i = 1 To number_of_rows
'matchedRow = Empty
On Error Resume Next 'Keep running if Excel MATCH function below doesn't find a match.
If Not IsEmpty(Cells(i, 1)) Then
matchedRow = Application.WorksheetFunction.Match(GWworkStations(i, 1), range("Col List!B:B"), 0)
If matchedRow = Empty Then Debug.Print "Empty " & matchedRow
If IsEmpty(matchedRow) Then 'No match.
MatchedEntries(i, 1) = "" 'GWworkStations(i, 1)
Else
'If GWworkStations(i, 1) = GWworkStations(i - 1) Then
If IsNumeric(matchedRow) Then 'Match was found.
MatchedEntries(i, 1) = Application.WorksheetFunction.Index(range("List!C:E"), matchedRow, 1)
Else 'MATCH function returned a non-numeric result.
MatchedEntries(i, 1) = ""
End If 'IsNumeric(MatchedRow)
End If 'IsEmpty(MatchedRow)
Else
End If
Next i
range("E2:G" & number_of_rows) = MatchedEntries() 'Write the tag name results out to range E:G.
Excel doesn't like the space in the sheet name. You can fix this by using single quotes: Range("'Col List'!B:B"), or by replacing Range("Col List!B:B")with Sheets("Col List").Columns(2).
You could also use the Range.Find method (which I would prefer):
matchedRow = Sheets("Sheet 3").Columns(2).Find(str).Row
I have a data set with Names and Addresses in an Excel file in following format.
Name1
134/47/1,
adrs1, adr2, country
Name2
adrs1, adrs2, country
Name3
107/c,
adrs3, adrs3, country
etc…
I want to split these data into multiple rows in following format
Name1
134/47/1,
adrs1,
adrs2,
country
Name2
No 134/63,
adrs1,
adrs2,
country
etc…
I tried following but it worked for one row cell only.
Sub tst()
Dim X As Variant
X = Split(Range("A1").Value, ",")
Range("A1").Resize(UBound(X) - LBound(X) + 1).Value = Application.Transpose(X)
End Sub
The following macro might help you. You would have to select the very last cell in your table containing a multipart address. When you start the macro it will then work its way up to the top and insert address lines where needed (only in the current column) and then exit.
Option Base 1
Sub trnsfrm()
Dim i%, n%, ret(3, 1)
Set r = Selection
Do
a = Split(r, ",")
ret(1, 1) = Trim(a(0))
ret(2, 1) = Trim(a(1))
ret(3, 1) = Trim(a(2))
r.Range([a2], [a3]).Insert Shift:=xlDown
r.Range([a1], [a3]) = ret
If r.Row <= 4 Then Exit Do
Set r = r.Offset(-4)
Loop
End Sub
If you want to insert lines across the whole table you should replace the line (10)
r.Range([a2], [a3]).Insert Shift:=xlDown
by
r.Range([a2], [a3]).EntireRow.Insert Shift:=xlDown
Assumptions / Warning
Since the macro will actually change your current table and 'undo' does not work with macros you should definitely save everything before you try it.
The macro assumes that each address block consists of exactly 4 lines. If there are fewer or more lines to an address the maro will get out of sync and will very likely output garbage or halt.
I'm not sure whether your sample data had trailing commas on single values as a typo or if that is what accurately represents your data but that should be accounted for. A rogue comma as a suffix will create an extra element to the variant array thereby throwing off dimensions created by referencing the UBound function.
Sub split_from_below_space()
Dim rw As Long, v As Long, vVALs As Variant
With Worksheets("Sheet1") 'set this worksheet reference properly!
For rw = .Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
.Cells(rw, 1) = Trim(.Cells(rw, 1).Value2)
If CBool(InStr(1, .Cells(rw, 1).Value2, Chr(44) & Chr(32))) Then
vVALs = Split(.Cells(rw, 1).Value2, Chr(44) & Chr(32))
.Cells(rw + 1, 1).Resize(UBound(vVALs), 1).EntireRow.Insert
.Cells(rw, 1).Resize(UBound(vVALs) + 1, 1) = _
Application.Transpose(vVALs)
For v = UBound(vVALs) - 1 To LBound(vVALs) Step -1
.Cells(rw, 1).Offset(v, 0) = _
Trim(.Cells(rw, 1).Offset(v, 0).Value2) & Chr(44)
Next v
End If
Next rw
End With
End Sub
You will need to insert rows to accommodate the data and that method is almost always (as in this case) better performed by working from the bottom to the top.