I am trying to change resource in SAP via excel macro. I need to find the row number of the focused cell and then insert a 'work shift' row.
I have already tried .CurrentCellRow, .SelectedRows & .GetRowPosition but unsuccessful.
Following is code I wrote till now,
Sub SAP_Entry_Plus(i As Variant)
Dim STime As String
Dim FTime As String
Dim CU As String
Session.findById("wnd[0]/tbar[1]/btn[26]").press
SlcDate = ThisWorkbook.Worksheets("Planned Shifts").Range("C" & i).Value
x = (Weekday(SlcDate, vbMonday) - 1)
MonDate = SlcDate - x
Session.findById("wnd[1]/usr/ctxtRC68K-DATUV_SEL").Text = MonDate
Session.findById("wnd[1]/tbar[0]/btn[0]").press
RNum2 = Session.findById("wnd[0]/usr/tblSAPLCRK0TC116").CurrentCellRow
RNum3 = Session.findById("wnd[0]/usr/tblSAPLCRK0TC116").SelectedRows
RNum4 = Session.findById("wnd[0]/usr/tblSAPLCRK0TC116").GetRowPosition
RNum5 = Session.findById("wnd[0]/usr/tblSAPLCRK0TC116").GetSelectedCellRow
RNum6 = Session.findById("wnd[0]/usr/tblSAPLCRK0TC116").GetCurrentCellRow
Session.findById("wnd[0]/usr/tblSAPLCRK0TC116").getAbsoluteRow(123).Selected = True
Session.findById("wnd[0]/usr/tblSAPLCRK0TC116/ctxtKAZA-KKOPF[2,6]").SetFocus
Session.findById("wnd[0]/tbar[1]/btn[6]").press
STime = Format(ThisWorkbook.Worksheets("Planned Shifts").Range("D" & i).Value, "hh:mm:ss")
FTime = Format(ThisWorkbook.Worksheets("Planned Shifts").Range("E" & i).Value, "hh:mm:ss")
CU = ThisWorkbook.Worksheets("Planned Shifts").Range("F" & i).Value
Session.findById("wnd[0]/usr/tblSAPLCRK0TC116/ctxtKAZA-BEGZT[8," & x + 1 & "]").Text = STime
Session.findById("wnd[0]/usr/tblSAPLCRK0TC116/ctxtKAZA-ENDZT[9," & x + 1 & "]").Text = FTime
Session.findById("wnd[0]/usr/tblSAPLCRK0TC116/txtKAZA-NGRAD[11," & x + 1 & "]").Text = CU
End Sub
You could try to solve with the following parameters:
set myTable = session.findById("wnd[0]/usr/tblSAPLCRK0TC116")
myRow = myTable.CurrentRow
myNumber_of_Rows = myTable.RowCount
myVis_Rows = myTable.VisibleRowCount
myPosition = myTable.VerticalScrollbar.Position
myAbsolute_Row = myPosition + myRow
The following link might also help a bit:
https://documentation.microfocus.com/help/index.jsp?topic=%2Fcom.borland.silktest.silk4net.doc%2Flangref%2FSAP%2FSapTableClass_ref.html
Related
I am trying to add to add French version to my code. I have macro that reads from text file report and extracts dates in correct format. Text file date format is JUL13/2023. My macro works just fine but sometimes dates appear in French - JAN - January, F:V – February, MAR - March, AVR - April, MAI- May, JUN - June, JLT - July, AO} – August, SEP – September, OCT – October, NOV - November, D:C – December. I am trying to find the best solution to add it into my code so it can read all possible dates and give me just regular date format as an output. Here is my code:
Sub test()
Dim fn As String, mtch As Object, m As Object, s As Object, txt As String
Dim i As Long
fn = "C:\temp\test.txt"
txt =CreateObject("scripting.filesystemobject").OpenTextFile(fn).ReadAll
With CreateObject("vbscript.regexp")
.Global = True
.Pattern = "[^\n]+"
Set mtch = .Execute(txt)
i = 1
Dim b As Long
b = 1
For Each m In mtch
.Pattern = "[a-zA-Z0-9]{7}\s\s[^\s]+\s[a-zA-Z\s]*[0-9]{2}\/[0-9]{4}"
For Each s In .Execute(m.Value)
i = i + 1
Cells(i, 1) = s
b = b + 1
Range("B" & b).Value = Right(Cells(i, 1), 10)
Next
Next
End With
Dim var As String
Dim N As Long, p As Long, j As Long
N = Cells(Rows.Count, "B").End(xlUp).Row
For p = 2 To N
var = Range("B" & p).Value
Range("C" & p).Value = convert_date(var)
Range("D" & p).Value = Range("C" & p) + 179
Range("E" & p).Value = Range("C" & p) + 209
j = j + 1
Next p
End Sub
Function convert_date(date_as_string As String) As Date
Dim mthstring As String
mthstring = "JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC"
convert_date = DateSerial( _
CInt(Right(date_as_string, 4)), _
CInt(((InStr(1, mthstring, Left(date_as_string, 3)) - 1) / 4) + 1), _
CInt(Replace(Mid(date_as_string, 4, 2), "/", "")))
End Function
Sub testConvertDate()
Dim var As String
Dim N As Long, i As Long, j As Long
N = Cells(Rows.Count, "B").End(xlUp).Row
Dim m As Integer
For i = 2 To N
'Range("B" & i).Value = Right("A" & i, 10)
var = Range("B" & i).Value
Range("C" & i).Value = convert_date(var)
Range("D" & i).Value = Range("C" & i) + 179
Range("E" & i).Value = Range("C" & i) + 209
j = j + 1
Next i
End Sub
And here is my outcome:
Because of the fact that your French months name enumeration contains strings of 3 or 4 characters, you need to process the string Date in a different way. Please, try the next adapted function. Do not miss to also copy the function returning only numbers (onlyNo):
Function convert_date(date_as_string As String) As Date
Dim mthstring As String, strLeft As String, arrD, dayNo As Long, monthNo As Long, y As Long
mthstring = "JANV,FEVR,MARS,AVRIL,MAI,JUIN,JUIL,AOUT,SEPT,OCT,NOV,DEC"
arrD = Split(mthstring, ",") 'place the string in an array
y = CLng(Split(date_as_string, "/")(1)) 'extract the year
strLeft = Split(date_as_string, "/")(0) 'extract the left string Date split by "/"
dayNo = onlyNo(strLeft) 'extract the day number
monthNo = Application.match(left(strLeft, Len(strLeft) - Len(CStr(dayNo))), arrD, 0) 'extract the month number
convert_date = DateSerial(y, monthNo, dayNo) 'convert to Date
End Function
Private Function onlyNo(strX As String) As Long
With CreateObject("vbscript.regexp")
.Pattern = "[^0-9]" 'replace everything except numbers
.Global = True
onlyNo = CLng(.replace(strX, "")) 'remove all letters
End With
End Function
The function should be called exactly as in your existing code.
You can simple test it using the next testing Sub. Please, uncomment the commented lines one by one and run it:
Sub testConvert_Date()
Dim d As String
d = "MAI31/2022"
'd = "JUIN20/2022"
'd = "NOV4/2022"
Debug.Print convert_date(d)
End Sub
If you need to adapt the function to work, at request, for English days name, too, I can easily adapt the function creating another parameter to select between languages.
Please, send some feedback after testing it.
Option Explicit
Function convert_date(s As String) As Date
Dim ar, arLang(1), regex, v
Dim y As Integer, m As String, d As Integer
arLang(0) = Split("JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC", ",")
arLang(1) = Split("JANV,FEVR,MARS,AVRIL,MAI,JUIN,JUIL,AOUT,SEPT,OCT,NOV,DEC", ",")
Set regex = CreateObject("vbscript.regexp")
With regex
.Global = False
.MultiLine = False
.Ignorecase = True
.Pattern = "([A-Z]+)(\d{1,2})\/(\d{4})"
End With
If regex.test(s) Then
With regex.Execute(s)(0)
m = .submatches(0)
d = .submatches(1)
y = .submatches(2)
End With
For Each ar In arLang
v = Application.Match(m, ar, 0)
If Not IsError(v) Then
convert_date = DateSerial(y, CInt(v), d)
Exit Function
End If
Next
End If
MsgBox s & " not correct format", vbExclamation
End Function
I have been trying to Concatenate two Columns directly from the Table1. But i really do not know how. I have tried and make below code.
But I have been creating first 2 helping Column in in "DI" and "DJ" to make this thing work.
I do not want to use these two helping columns directly wants the concatenate result in "DK2"
All help will be appreciaed.
Dim O As String
Dim P As String
O = "Milestone"
P = "Task"
Sheet1.Range("Table1[" & O & "]").Copy
Sheet2.Range("DI2").PasteSpecial xlPasteValues
Sheet1.Range("Table1[" & P & "]").Copy
Sheet2.Range("DJ2").PasteSpecial xlPasteValues
For i = 2 To Cells(Rows.Count, "DH").End(xlUp).Row
Sheet2.Cells(i, "DK").Value = Sheet2.Cells(i, "DI").Value & "" & Sheet2.Cells(i, "DJ").Value
Next i
Here is the example Picture
Try this.
Range("DK2").Resize(Sheet2.ListObjects("Table1").ListRows.Count) = Application.Evaluate("Table1[Milestone]&Table1[Task]")
EDIT: I've seen #norie's answer and it is simpler and more efficient than mine. I'll keep my answer here for anyone who is curious, but I recommend using his solution.
The trick is to use =INDEX(YOUR_TABLE[YOUR_COLUMN]], YOUR_ROW_STARTING_FROM_1) in order to obtain the cell contents that you needed.
Here you are your code edited:
Original
Dim O As String
Dim P As String
Dim i As Integer
O = "Milestone"
P = "Task"
For i = 1 To Application.Evaluate("ROWS(Table1[" & O & "])")
Sheet2.Cells(i, "DK").Value = Application.Evaluate("INDEX(Table1[" & O & "], " & i & ") & INDEX(Table1[" & P & "], " & i & ")")
Next i
Optimized
Dim O As String
Dim P As String
Dim i As Integer
O = "Milestone"
P = "Task"
' Disable formula recalculation while trying to add our data to increase performance
Application.Calculation = xlManual
' Disable screen updating while trying to add our data to improve performance
Application.ScreenUpdating = False
For i = 1 To Application.Evaluate("ROWS(Table1[" & O & "])")
Sheet2.Cells(i, "DK").Value = Application.Evaluate("INDEX(Table1[" & O & "], " & i & ") & INDEX(Table1[" & P & "], " & i & ")")
Next i
' Enable again formula's automatic evaluation.
Application.Calculation = xlAutomatic
' Enable again screen updating
Application.ScreenUpdating = True
Optimized using only Formulas (this performs better that the others)
Dim O As String
Dim P As String
Dim i As Integer
O = "Milestone"
P = "Task"
' Disable formula recalculation while trying to add our data to increase performance
Application.Calculation = xlManual
' Disable screen updating while trying to add our data to improve performance
Application.ScreenUpdating = False
For i = 1 To Application.Evaluate("ROWS(Table1[" & O & "])")
Sheet2.Cells(i, "DK").FormulaR1C1 = "=INDEX(Table1[" & O & "], " & i & ") & INDEX(Table1[" & P & "], " & i & ")"
Next i
' Enable again formula's automatic evaluation.
Application.Calculation = xlAutomatic
' Enable again screen updating
Application.ScreenUpdating = True
Optimized using Formulas and then converting back to values
Dim O As String
Dim P As String
Dim i As Integer
O = "Milestone"
P = "Task"
' Disable formula recalculation while trying to add our data to increase performance
Application.Calculation = xlManual
' Disable screen updating while trying to add our data to improve performance
Application.ScreenUpdating = False
For i = 1 To Application.Evaluate("ROWS(Table1[" & O & "])")
Sheet2.Cells(i, "DK").FormulaR1C1 = "=INDEX(Table1[" & O & "], " & i & ") & INDEX(Table1[" & P & "], " & i & ")"
Next i
' Enable again formula's automatic evaluation.
Application.Calculation = xlAutomatic
' Enable again screen updating
Application.ScreenUpdating = True
' Convert from formulas to values
Range("DK:DK").Copy
Range("DK:DK").PasteSpecial xlPasteValues
This can be done directly in the worksheet by using the Index function
Reference first cell in the table: =INDEX(Table1,1,1)
Concatenate cell 1 and 2 values: =INDEX(Table1,1,1)&INDEX(Table1,1,2)
It gets slightly more complicated if you want to be able to copy formulae across or down as you need to reference the current cell location
Reference first cell in the table using offsets: =INDEX(Table1,ROW()-X,COLUMN()-Y) where X, Y (minus data location offsets) are the numerical row/column of the cell where you have placed the formula.
i.e. if placing the formula in E2 to reference Table1 cell(1,1) => =INDEX(Table1,ROW()-1,COLUMN()-4)
where Column E=> Offset 4, Row 2 => Offset 1
or: =INDEX(Table1,ROW()-ROW($E$2)+1,COLUMN()-COLUMN($E$2)+1)
You can now autofill the formula down or across
Concatenate List Columns
With your amount of data both solutions may seem equally efficient. I've tested it with a million rows of random numbers from 1 to 1000, and the first solution took about 3.5 seconds, while the second took about 5.5 seconds on my machine. The first solution is just a more elaborate version of norie's answer.
In this solution, you can add more columns (headers) and use a delimiter. While adding more columns the difference in the efficiencies will become more apparent, while when adding more characters to the delimiter, the efficiencies will decrease seemingly equally.
The Code
Option Explicit
Sub concatListColumnsEvaluate()
Dim dTime As Double: dTime = Timer
' Define constants.
Const TableName As String = "Table1"
Const HeadersList As String = "Milestone,Task"
Const dFirst As String = "D2"
Const Delimiter As String = ""
' Determine table rows count.
Dim rCount As Long: rCount = Sheet1.ListObjects(TableName).ListRows.Count
' Create Evaluate Expression String.
Dim Headers() As String: Headers = Split(HeadersList, ",")
Dim tUpper As Long: tUpper = UBound(Headers)
Dim evString As String
Dim t As Long
If Len(Delimiter) = 0 Then
For t = 0 To tUpper
evString = evString & TableName & "[" & Headers(t) & "]" & "&"
Next t
evString = Left(evString, Len(evString) - 1)
Else
For t = 0 To tUpper
evString = evString & TableName & "[" & Headers(t) & "]" & "&""" _
& Delimiter & """&"
Next t
evString = Left(evString, Len(evString) - Len(Delimiter) - 4)
End If
' Write values to Destination Range.
Sheet2.Range(dFirst).Resize(rCount).Value = Application.Evaluate(evString)
Debug.Print Timer - dTime
End Sub
Sub concatListColumnsArrays()
Dim dTime As Double: dTime = Timer
' Define constants.
Const TableName As String = "Table1"
Const HeadersList As String = "Milestone,Task"
Const dFirst As String = "D2"
Const Delimiter As String = ""
' Write values from list columns to arrays of Data Array.
Dim Headers() As String: Headers = Split(HeadersList, ",")
Dim tUpper As Long: tUpper = UBound(Headers)
Dim Data As Variant: ReDim Data(0 To tUpper)
Dim t As Long
For t = 0 To tUpper
' Either...
Data(t) = Sheet1.Range(TableName & "[" & Headers(t) & "]").Value
' ... or:
'Data(t) = Sheet1.ListObjects(TableName) _
.ListColumns(Headers(t)).DataBodyRange.Value
Next t
' Concatenate values of arrays of Data Array in Result Array.
Dim rCount As Long: rCount = UBound(Data(0), 1)
Dim Result As Variant: ReDim Result(1 To rCount, 1 To 1)
Dim r As Long
If Len(Delimiter) = 0 Then
For r = 1 To rCount
For t = 0 To tUpper
Result(r, 1) = Result(r, 1) & Data(t)(r, 1)
Next t
Next r
Else
For r = 1 To rCount
For t = 0 To tUpper
Result(r, 1) = Result(r, 1) & Data(t)(r, 1) & Delimiter
Next t
Result(r, 1) = Left(Result(r, 1), Len(Result(r, 1)) _
- Len(Delimiter))
Next r
End If
' Write values from Result Array to Destination Range.
Sheet2.Range(dFirst).Resize(rCount).Value = Result
Debug.Print Timer - dTime
End Sub
I’m setting up a simple form containing about 15 fields which at the end are copied and saved in my database (same excel file but separate spreadsheet). Then I need to design a procedure which will enable me to amend existing records.
I’ve created one which recalls all the data from database back in to the form so they can be amended and then saved. It worked fine but I don’t really know when to put the ELSE for the case when searched record doesn’t exist in the table.
Public Sub amend()
Dim spec_number As Long
Dim licznik As Long
Dim x As Long
Dim specyfikacje As Worksheet
Dim formularz As Worksheet
Set specyfikacje = Sheets("specifications")
Set formularz = Sheets("form")
spec_number = formularz.Range("b4").Value
If spec_number = "" Then
MsgBox "Type the specification number in the designated field: B4"
Else
licznik = 2
x = 2
Do Until (specyfikacje.Range("A" & licznik).Value = "") = True
licznik = licznik + 1
Loop
Do Until x > licznik
If spec_number = specyfikacje.Range("a" & x).Value Then
formularz.Range("b6") = specyfikacje.Range("b" & x).Value
formularz.Range("b7") = specyfikacje.Range("c" & x).Value
formularz.Range("b8") = specyfikacje.Range("d" & x).Value
formularz.Range("b9") = specyfikacje.Range("e" & x).Value
formularz.Range("b10") = specyfikacje.Range("f" & x).Value
formularz.Range("b11") = specyfikacje.Range("g" & x).Value
formularz.Range("b12") = specyfikacje.Range("h" & x).Value
formularz.Range("b13") = specyfikacje.Range("i" & x).Value
formularz.Range("b14") = specyfikacje.Range("j" & x).Value
formularz.Range("b15") = specyfikacje.Range("k" & x).Value
formularz.Range("b16") = specyfikacje.Range("l" & x).Value
formularz.Range("b17") = specyfikacje.Range("m" & x).Value
formularz.Range("b18") = specyfikacje.Range("n" & x).Value
formularz.Range("b19") = specyfikacje.Range("o" & x).Value
formularz.Range("b20") = specyfikacje.Range("p" & x).Value
formularz.Range("b21") = specyfikacje.Range("q" & x).Value
formularz.Range("b22") = specyfikacje.Range("r" & x).Value
formularz.Range("b23") = specyfikacje.Range("s" & x).Value
Else
MsgBox "The product you typed in doesn't exist"
End If
x = x + 1
Loop
End If
End Sub
I think if you replace your code with the following, it should work as expected:
Dim licznik As Long
Dim x As Long
Dim specyfikacje As Worksheet
Dim formularz As Worksheet
Set specyfikacje = Sheets("specifications")
Set formularz = Sheets("form")
spec_number = formularz.Range("b4").Value
If spec_number = "" Then
MsgBox "Type the specification number in the designated field: B4"
Else
licznik = specyfikacje.Cells(specyfikacje.Rows.Count, "A").End(xlUp).Row 'find the last row on Column A on Sheet specifications
With specyfikacje.Range("A:A")
Set Rng = .Find(What:=spec_number) 'search column A of specifications for the spec_number
If Not Rng Is Nothing Then 'if found
For x = 1 To 18
formularz.Range("b" & i + 5) = Rng.Offset(0, i).Value
Next x
Else
MsgBox "The product you typed in doesn't exist"
End If
End With
End If
End Sub
in a VBA excel macro I am using, I have the following code:
For k = MinDeg To MaxDeg
OutputStr = Trim(OutputStr & "a" & Str(k) & " = " & _
Str(MyCoe) & " ± " & _
Str(MyErr) & Chr(10))
Next k
Where "MyCoe" and "MyErr" are given numbers, and "minDeg" and "MaxDeg" are integers.
My question is:
How can I make "Str(k)" appear in the outputstr as subscript text?
If Unicode is available in your environment, another option would be to use the subscripted Unicode characters for Str(K). Making some modifications to Gary's Student code so as to get output in A1:
Option Explicit
Sub foo()
Dim K As Long
Const MinDeg As Long = 10
Const MaxDeg As Long = 13
Dim sK As String, I As Long
Const MyCoe As Long = 3
Const MyErr As Long = 5
Dim OutPutStr As String
For K = MinDeg To MaxDeg
sK = ""
For I = 1 To Len(CStr(K))
sK = sK & ChrW(832 & Mid(CStr(K), I, 1))
Next I
OutPutStr = Trim(OutPutStr & "a" & sK & " = " & _
Str(MyCoe) & " ± " & _
Str(MyErr) & Chr(10))
Next K
Cells(1, 1) = OutPutStr
End Sub
Note that the subscripted values also appear in the formula bar.
First I run this simple mod to your code:
Sub WhatEverr()
mindeg = 10
maxdeg = 13
mycoe = 3
myerr = 5
For k = mindeg To maxdeg
outputstr = Trim(outputstr & "a" & Str(k) & " = " & _
Str(mycoe) & " ± " & _
Str(myerr) & Chr(10))
Next k
Range("A1").Value = outputstr
End Sub
to get this in A1:
Then I run:
Sub formatcell()
Dim i As Long, L As Long, rng As Range
Dim s As String
Set rng = Range("A1")
s = rng.Value
L = Len(s)
For i = 1 To L
ch = Mid(s, i, 1)
If ch = "a" Then
rng.Characters(Start:=i + 2, Length:=2).Font.Subscript = True
End If
Next i
End Sub
To apply the format:
In Excel, this type of character formatting is a property of the Range object. You do not build it into the string like you would in HTML.
I'm trying to compared 2 different excel files that contain same fields sometimes.
When I find it (by watch view) the vba say they are different...
Dim ctrl As Integer
Sub btnCheck_Click()
Dim lot As Workbook, pr As Workbook, this As Workbook
Dim a As Variant, b As Variant
Dim i As Integer, j As Integer
Dim passed As Boolean
Set this = Application.ThisWorkbook
this.Worksheets(1).Range("C5:J1000").ClearContents
Application.ScreenUpdating = False
a = ThisWorkbook.Path & "\" & "A.xlsx"
Set lot = Application.Workbooks.Open(a, False, False)
b = ThisWorkbook.Path & "\" & "B.xls"
Set pr = Application.Workbooks.Open(b, False, False)
i = 2
x = 2
lin = 2
Do Until lot.Worksheets(1).Range("A" & i).Value = ""
passed = False
j = 2
Do Until pr.Worksheets(1).Range("A" & j).Value = ""
If lot.Worksheets(1).Range("B" & i).Value = pr.Worksheets(1).Range("C" & j).Value Then
passed = True
this.Worksheets(1).Range("D" & x).Value = "ok"
x = x + 2
End If
j = j + 1
Loop
i = i + 1
Loop
lot.Close True
Set lot = Nothing
pr.Close True
Set pr = Nothing
Application.ScreenUpdating = True
End Sub
Function CleanStr(ByVal str As String)
CleanStr = Replace(str, Chr$(32), "")
End Function
The files A and B are linked at the comments bellow.
A and B are not the same. One ends in a space (ASCII 32) while the other ends in a non-breaking space (ASCII 160). Invisible is invisible to our eyes, but to a computer, ASCII(32)<>ASCII(160)
You can verify this by adding this function to your macro:
Function strings2ascii(ByVal str1 As String, str2 As String)
Dim x As Integer
Dim intStrLen As Integer
Dim strResult As String
If Len(str1) > Len(str2) Then
intStrLen = Len(str1)
Else
intStrLen = Len(str2)
End If
For x = 1 To Len(str1)
strResult = strResult & Asc(Mid(str1, x, 1)) & ":" & Asc(Mid(str2, x, 1)) & vbCrLf
Next
MsgBox strResult
End Function
Now call this function in your loop:
Do Until pr.Worksheets(1).Range("A" & j).Value = ""
strings2ascii lot.Worksheets(1).Range("B" & i).Value, pr.Worksheets(1).Range("C" & j).Value
If lot.Worksheets(1).Range("B" & i).Value = pr.Worksheets(1).Range("C" & j).Value Then
You will immediately see that they never match because they are not the same. Here is a similar SO post regarding ASCII 160 errors: Trouble replacing Chr(160) with VBA in excel
Not sure if this will answer the question but that can't stand in a comment :)
I would say that some cells contains invisible chars that arent spaces.
Here's a recursive function that remove them from a string :
Function CleanString(StrIn As String) As String
' "Cleans" a string by removing embedded control (non-printable)
' characters, including carriage returns and linefeeds.
' Does not remove special characters like symbols, international
' characters, etc. This function runs recursively, each call
' removing one embedded character
Dim iCh As Integer
CleanString = StrIn
For iCh = 1 To Len(StrIn)
If Asc(Mid(StrIn, iCh, 1)) < 32 Then
'remove special character
CleanString = Left(StrIn, iCh - 1) & CleanString(Mid(StrIn, iCh + 1))
Exit Function
End If
Next iCh
End Function
Give it a try like this :
Do Until b.Worksheets(1).Range("A" & j).Value = ""
sa = CleanString(a.Worksheets(1).Range("B" & i).Value)
sb = CleanString(b.Worksheets(1).Range("C" & j).Value)
oa = CleanString(a.Worksheets(1).Range("E" & i).Value)
ob = CleanString(b.Worksheets(1).Range("F" & j).Value)
If StrComp(sa, sb) = 0 And StrComp(oa, ob) = 0 Then
Passed = True