Sub ARC()
x = Range(“A1″): If x “” Then Application.ScreenUpdating = False
wb = “ShaQuR.xls”: n = “‘[SHA.XLS]MAC’!”: n1 = “‘[" & wb & "]MAC’!”: aa = ActiveSheet.Name
t = Timer: w = ActiveCell: c = ActiveCell.Column: r = ActiveCell.Row: s = Selection.Count
p = Range(n & “A4″).End(xlDown).Row + 1: Range(n & “A” & p) = ActiveSheet.Name()
Range(n & “B” & p) = c & ” ” & r & ” ” & s & ” ” & w: Range(n & “C” & p) = Now
If Range(n1 & “E1″) “OK” Then GoTo SHE
If p / 10 – Int(p / 10) = 0 Then Workbooks(“SHA.XLS”).Save
If s > 3 Then Application.Run (“GEN.GEN”): GoTo SHE
‘EOI ——————————————————————————-EOI
SOD:
‘w = Cells(ActiveCell.Row, 1)
If c = 1 And r = 2 Then GoTo SHZ
If (c = 1 Or c > 5) And r > 2 And x > 0 Then GoTo SHH ‘
If c > 5 And r > 2 And x = “” Then GoTo SHJ
If c = 2 And r < 4 Then GoTo SHC
If c = 3 And r 2 Then GoTo SHK
If c = 4 And r = 2 Then GoTo SHF
If c = 5 And r = 1 Then GoTo SHD
If c = 6 And r = 1 Then GoTo SHI
If c > 9 And r = 1 Then GoTo SHJ ‘find TRN key word in SUM
If c = 6 And r = 2 Then GoTo SHB
GoTo SHE:
SHA:
ActiveCell.Copy: AppActivate “Program Al Quran”
SendKeys (“{esc 3}%cp{tab 3}{up}{tab 4}~{tab 8}”)
GoTo SHE:
SHB:
r = Range(“G1″): Cells(r, 2).ClearContents
‘For r = 3 To 6239
For j = 6 To Range(“E” & r).End(xlToRight).Column
w = Left(Cells(r, j), 1)
If w = “Ç” Or w = “Ô Or w = “” Or w = “Å” Then GoTo bhs
w1 = Range(“LET!B3:B39″).Find(w).Offset(0, 1)
If Left(Range(“TRM!A” & r).Offset(0, j – 1), 1) w1 Then _
Cells(r, j).Font.ColorIndex = 3: Cells(r, 2) = Cells(r, 2) + 1
bhs:
Next j
Sheets(“TRM”).Select: Range(“TRM!A3:A6239″).Find(Range(“A” & r)).Activate
Sheets(“ARC”).Select
‘Next r
GoTo SHE
SHC:
Range(“F3:EZ6239″).ClearContents
If r = 2 Then rge = “E3:E6239″ Else rge = “E3:E” & Range(“B3″).End(xlDown).Row
If r = 1 Then stf = False Else: stf = True
Range(rge).TextToColumns Destination:=Range(“F3″), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=stf, Other:=True, _
OtherChar:=Chr(10), FieldInfo:=Array(1, 1)
If r = 1 Then Range(“B3:B6239″).FormulaR1C1 = “=COUNTA(RC[4]:RC[31])”: _
Range(“B3:B6239″).Copy: Range(“B3″).PasteSpecial xlPasteValues _
Else: Range(“F3:F6239″).Delete Shift:=xlToLeft
GoTo SHE
SHD:
If Range(“D3″) = “” Then GoTo SHE
hin = Range(“E1″) + 2: Range(“D3:D” & hin).Copy: Range(“E3″).PasteSpecial xlPasteValues
Range(“E3:E” & hin).Replace ” ” & Chr(10), “”
Range(“E3:E” & hin).Replace Chr(10) & Chr(10), Chr(10): Range(“E3:E” & hin).WrapText = False
‘GoTo SHE
Range(“B3:B” & hin).FormulaR1C1 = “=”" “” &TRIM(RC[3])&”" “”": Range(“B3:B” & hin).Copy
Range(“E3″).PasteSpecial xlPasteValues: Range(“B3:D” & hin).ClearContents
GoTo SHE
SHF:
rgc = “C3:C6239″: wod = ” ” & Range(“C1″) & ” “: woe = Chr(10) & Range(“C1″) & ” “
Range(“D3:D6239″).Copy: Range(“C3″).PasteSpecial xlPasteAll
Range(rgc).Replace wod, woe, xlPart: Range(rgc).WrapText = False: Range(rgc).Copy
Range(“D3″).PasteSpecial xlPasteValues: Range(rgc).ClearContents
GoTo SHE
SHG:
Range(“F3:EZ6239″).ClearContents
If r = 1 Then stf = False Else: stf = True
Range(“D3:D6239″).TextToColumns Destination:=Range(“F3″), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=stf, Other:=True, _
OtherChar:=Chr(10), FieldInfo:=Array(1, 1)
If r = 1 Then Range(“B3:B6239″).FormulaR1C1 = “=COUNTA(RC[4]:RC[31])”: _
Range(“B3:B6239″).Copy: Range(“B3″).PasteSpecial xlPasteValues _
Else: Range(“F3:F6239″).Delete Shift:=xlToLeft
GoTo SHE
SHH: ‘serch multi length word
Application.ScreenUpdating = False
fil = “CAM”: rs = 3
If c = 1 Then w1 = Range(“C1″): GoTo HHS
Range(“J1:Z1″).ClearContents: Selection.Copy
Range(“J1″).PasteSpecial xlPasteValues
If Range(“J2″) “C5″ Then Range(“J2″) = “C5″: GoTo hha
w1 = “”
For i = 10 To 9 + Range(“I1″)
w1 = w1 & ” ” & Cells(1, i)
Next i
HHS:
Range(“C1″) = Trim(w1)
Range(“G1″).FormulaR1C1 = “=CODE(RC[-4])”
If Range(“G1″) 17842 Then rf = Range(“D3:D17842″).Find(Range(“D” & rf), _
Range(“D3″), xlFormulas, xlWhole).Row
Range(“Y” & rf).Select
Range(“A1″) = 1
Application.Run “MIX.MIX”
GoTo SHE
SHI:
Range(“C1″).Copy
AppActivate “Program Al Quran”
SendKeys (“{esc 3}%cp{tab 3}{up}{tab 4}~{tab 8}”)
GoTo SHE
SHJ: ‘if s=3 then stop
Windows(wb).Activate: Sheets(“MIX”).Select
Range(“C3:C20000″).Find(w, Range(“C3″), xlFormulas, xlWhole).Activate
GoTo SHE
SHK:
If r = 3 Then sr = Range(“D1″): fr = 6239 Else sr = r: fr = r
For r = sr To fr
Range(“C” & r).FormulaR1C1 = “=COUNTA(RC[3]:RC[131])”
wp = “”: rgm = “MIX!C3:C20000″: rm = “MIX!C3″
For i = 1 To Range(“C” & r)
w = Range(“E” & r).Offset(0, i)
rf = Range(rgm).Find(w, Range(rm), xlFormulas, xlWhole).Row
If rf > 17842 Then rf = Range(“MIX!D2:D17842″).Find(Range(“MIX!D” & rf), _
Range(“MIX!D2″), xlFormulas, xlWhole).Row
wt = Range(“MIX!B” & rf)
wa = Range(“MIX!C” & rf)
wb = Range(“MIX!AB” & rf)
wr = Range(“MIX!Y” & rf)
wm = Range(“MIX!AA” & rf)
we = Range(“MIX!Z” & rf)
wc = Range(“CHK!A6:A3000″).Find(wr, Range(“CHK!A6″), xlFormulas, xlWhole).Offset(0, 22)
‘ws = wb & wc & we & ” v ” & “[" & wa & " x " & wt & "]“
ws = wb & wc & we & ” v ” & “[" & wa & "x]“
wp = wp & ” ” & ws & “_”
Next i
Range(“C” & r).Value = wp & Chr(10) & Chr(10) & Range(“D” & r)
Range(“C” & r).WrapText = False
Next r
GoTo SHE
SHZ:
Sheets(“ARC”).Select
Range(“D3:D6239″).Copy
Range(“B3″).PasteSpecial xlPasteAll
For i = 3 To 3
If i = 1 Then wod = “, “
If i = 2 Then wod = “. “
If i = 3 Then wod = “: “
Range(“B3:B6239″).Replace wod, wod & Chr(10), xlPart
Next i
Range(“B3:B6239″).WrapText = False
GoTo SHE
SHE: Application.ScreenUpdating = True: Range(n & “D” & p) = Timer – t: End Sub
