[BW] Bex VBA - Example 1

Sub SAPBEXonRefresh(queryID As String, resultArea As Range)
Dim ws As Worksheet, myCell As Range, docWS As Worksheet
Dim firstRow As Long, lastRow As Long
Dim firstCol As Integer, lastCol As Integer
Dim myRange As Range, ProdFam As String, SubFam As String
Dim firstResultCol As Integer

'indentify / select worksheet containing query results
Set ws = resultArea.Parent
If ws Is Nothing Then
Exit Sub
Else:
ws.Select
End If

'locate first and last row and column in query results
Set myRange = resultArea
firstRow = myRange.Cells(1).Row
firstCol = myRange.Cells(1).Column
lastRow = myRange.Cells(myRange.Cells.Count).Row
lastCol = myRange.Cells(myRange.Cells.Count).Column

'find columns for Product Family and Sub Family,
'customer Number and product name, and first result column
pfCol = 0: sfCol = 0: custCol = 0: prodCol = 0: firstResultCol = 0
custNum = 0: custName = 0: prodCol = 0
For j = firstCol To lastCol
If Cells(firstRow + 1, j) Like "*Product Family*" Then pfCol = j
If Cells(firstRow + 1, j) Like "*Prod Sub-Family*" Then sfCol = j
If Cells(firstRow + 1, j) Like "*Customer*" Then custCol = j
If Cells(firstRow + 1, j) Like "*Fin Prod*" Then prodCol = j
If firstResultCol = 0 And Cells(firstRow, j).Style Like "*Item*" Then
firstResultCol = j
Exit For
End If
Next j

'ensure that we found all required columns
If pfCol = 0 Or sfCol = 0 or custCol = 0 or prodCol = 0 Then
MsgBox "Unable to locate all requuired columns." _
& vbLf & vbLf & "Routine will now terminate.", _
vbCritical, "Routine did not update successfully"
Exit Sub
End If


'now work on each row in result table
For i = firstRow + 1 To lastRow
'do some things based on results found in each row
Next i

'eliminate X from Key Figures
If firstResultCol > 0 Then
Set myRange = Range(Cells(firstRow + 1, firstResultCol), Cells(lastRow, lastCol))
myRange.Replace What:="X", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
End If


End Sub