نجوم المشاركات

احنا ما تفقنا يا استاذ فايز ان الصورة فيها الجزء المفيد فقط ، حتى نقدر نشوف الخطأ وين 🙂 لا يمكن استيراد البيانات بالطريقة السابقة ، لهذا السبب وجب علينا ان نمشي بها سطر بسطر : Dim ImportFileName As String Dim rst1, rst2 As DAO.Recordset Dim i As Long ImportFileName = Me.txtPath CurrentDb.Execute ("Delete * From Table1") CurrentDb.Execute ("Delete * From Temp4") DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Temp4", ImportFileName, False Set rst1 = CurrentDb.OpenRecordset("Select F2 From Temp4 Where F2 Is Not Null") Set rst2 = CurrentDb.OpenRecordset("Select * From Table1") rst2.AddNew Do Until rst1.EOF i = i + 1 If i = 1 Then rst2![Academic Year] = rst1!F2 ElseIf i = 2 Then rst2![Academic Num] = Mid(rst1!F2, InStrRev(rst1!F2, " ") + 1) ElseIf i = 3 Then rst2![StName] = rst1!F2 ElseIf i = 4 Then rst2![F1] = rst1!F2 ElseIf i = 5 Then rst2![Subjects] = rst1!F2 End If rst1.MoveNext Loop rst2.Update rst1.Close: Set rst1 = Nothing rst2.Close: Set rst2 = Nothing MsgBox "تم استيراد البيانات بنجاح" 'F2 '1=1438-1439 '2=الرقم الأكاديمي 38002 '3=يوسف بن رضا بن حسن مصباح '4=المواد المسجلة في الفصل الدراسي الثاني 1440-1441 '5=رياضيات 4 الشعبة 5 - تربية صحية وبدنية الشعبة 5 - اللغة العربية 4 الشعبة 5 - إنجليزي 4 الشعبة 5 - أحياء 2 الشعبة 5 جعفر Posters.zip

وعليكم السلام 🙂 IIf([name]="A" or [name]="B",500,700) جعفر

من الأخطاء الشائعة في المنتدى تعريف المتغيرات بصورة غير صحيحة في الـ VBA، مع أن هذه الطريقة صحيحة في بعض اللغات. والخطأ هو صف مجموعة متغيرات في تعريف واحد ، وفي هذه الحالة سوف يتم تعريف المتغير الأخير فقط أما المتغيرات التي قبله سوف سوف يكون نوعها Variant والصح هو تعريف كل متغير على حدى مثال: 'الخطأ Sub Test() Dim a, b As Double Dim rst1, rst2 As Recordset Debug.Print VarType(a) Debug.Print VarType(b) Debug.Print VarType(rst1) Debug.Print VarType(rst2) End Sub 'الصح Sub Test2() Dim a As Double, b As Double Dim rst1 As Recordset, rst2 As Recordset Debug.Print VarType(a) Debug.Print VarType(b) Debug.Print VarType(rst1) Debug.Print VarType(rst2) End Sub

عندي طريقة لربما تعتبر طريق فرعي وترابي ايضا مقارنة بطريقة أخي @jjafferr سوف ارفقها ..... بشرط أن يضع لنا الاستاذ جعفر طريق سريع ومسفلت ... Sub RecordPorssesing() On Error Resume Next Dim rs, rs2, rsq As Recordset, Dbs As Database Dim StrSql As String Dim x, r, I, p, z As Integer Set Dbs = CurrentDb Set rsq = Dbs.OpenRecordset("Temp4") Set rs = Dbs.OpenRecordset("SELECT Temp4.F2 FROM Temp4 WHERE (((Temp4.F2) Is Not Null));") rsq.MoveLast rsq.MoveFirst For z = 1 To rs.RecordCount Step 5 For I = 1 To rsq.RecordCount Step 5 Set rs2 = Dbs.OpenRecordset("tbl_bar") rs2.AddNew rs2.Fields(0) = rsq.Fields(0) r = 0 For p = 1 To 5 rs2.Fields(r) = rs.Fields(0) r = r + 1 rs.MoveNext Next p rs2.Update rsq.MoveNext Next I Next z Set rs = Nothing Set rs2 = Nothing Set rsq = Nothing DoCmd.OpenTable "tbl_bar" End Sub Posters.accdb

فورم اكسل للبحث عن ايات القران الكريم وتفسيره ورقم الجذء والصفحة الفيديو فورم بحث عن ايات القران الكريم واجزائة.xlsm

الظاهر كلامي بالفعل يحتاج له توضيح 🙂 اخي الفاضل ، اما تصحيحك للكود ، فانا قلت فيه : اما السطر الثالث : 1. من الكود الذي وضعه صاحب الموضوع ، ومن سؤاله ، يتضح مدى معرفة صاحب الموضوع بالكود ، وبالفعل ، حدسي كان في محله ، وفي مشاركته الثانية اكد هذا الكلام 🙂 لهذا السبب ، ما اردت ان اعمل تغيير جوهري في الكود حتى يفهم التصحيح اللي انا عملته ، وما اردت ان اعمل اي تغيير خارج الكود كذلك حتى يفهم التصحيح اللي انا عملته 🙂 2. والسبب في كل هذا ، حتى السائل يفهم التعديل اللي انا عملته ، وما يضيع ، 3. اما اذا ما فهم التعديل ، فبالتالي بيضيع ، ومو هذا المطلوب بالشرح 🙂 وانا والاستاذ رمهان دائما في اخذ وعطاء في موضوع الكود ، فهو ماشاءالله محترف في التخزيل والاختصار (وهذا هو الاحتراف) ، بينما انا اشرح بخطوات اكثر (وليس هذا بالاحتراف) ، ولكن وجهة نظري هي ، ان السائل لن يفهم الكود المقتضب ، ولن يستطيع تعديله في المستقبل ، لهذا السبب اتعمد الكود الاطول (او يمكن لأني من المدرسة القديمة وما اخذت اي دروس في البرمجة !!) ، اذن الحمدلله ان فايروس كورونا منه فائدة ، وهو وجودك معانا ، فأهلا وسهلا بك اخي الفاضل معانا في كل وقت 🙂 اعضاء منتديات البرمجة العالميه بوجه عام ، متطوعين ، وما كلهم بنفس المستوى ، ولكن الهدف هنا مساعدة الآخرين ، ونرحب بوجود المحترفين ، ونرحب بوجودك معنا ، وهذا الميدان يا حميدان 🙂 جعفر

الكثير منّا يحاول ادخال التاريخ في الكومبوبوكس لكن المشكلة انه يظهر بالتنسيق الأميركي (شهر /يوم /سنة) بحلية بسيطة يمكننا ان نخدع الاكسل لأدخال التاريخ في الكومبوبوكس كما نريد نحن (يوم/شهر/ سنه) اذ ليس الامر باختياره انظر الى الملف المرفق لتعرف ماذا اعني Reel_date_to Combo.xlsm

بصراحة ... هذه عملية استفزاز لك ... حتى تخرج لنا بعض الكنوز التي لديك لنستفيد منها .... بارك الله فيك اخي @jjafferr

سيضعه بإذن الله .. وبشرط أيضا بدون كيمرات رصد تجاوز السرعة القانونية

شكراً لك أستاذي ومعلمي جعفر وهذه بعض محاولاتي لإنشاء مربع قيم متعددة تضاف القيمة بالنقر مرتين وتزال القيمة أيضا بالنقر مرتين . وهذا كود مربع القائمة Private Sub listBoox_DblClick(Cancel As Integer) 'inStr = "لمعرفة موضع ظهور السلسلة النصية" Text9 = InStr(1, txt1, listBoox.Column(0), vbTextCompare) If Text9 = 0 Or Len(txt1 & "") = 0 Then 'For Each = "الدوران على القيم وإَضافتها إلى حقل المستهدف" For Each m In listBoox.ItemsSelected txt1 = txt1 & listBoox.ItemData(m) & ";" Next Else 'في حال إضافة القيمة مرة أخرى يتم الحذف txt1 = Replace(txt1, listBoox & ";", "") End If End Sub وكود إخفاء وإظهار مربع القائمة Private Sub C_List_Click() If C_List.Caption = "إظهار" Then listBoox.Left = txt1.Left listBoox.Top = txt1.Top + txt1.Height listBoox.Height = 1400 listBoox.Width = txt1.Width listBoox.Visible = True C_List.Caption = "إخفاء" Else C_List.Caption = "إظهار" listBoox.Visible = False End If End Sub بالمرفق الملف SQL_multivalue_field.zip

وعليكم السلام بعد اذن الاستاذ جعفر الحل الوارد باانشاء جداول تابعة في حال تعدد الحالة صعب جرب StudentCourses.zip وهي من احدى الملفات المرفوعة من مساهمات خبراء الاكسيس روابط قاعاعدة بيانات اكسيس

مثال تطبيقي حول التعامل مع المتصفح: الدخول إلى موقع أوفيسنا في متصفح Internet Explorer من خلال الأكسس المثال التالي يمكننا من إدخال اسم المستخدم و كلمة مرور أوفيسنا و عند الضغط على زر الدخول يفتح الموقع بحسابك الخاص في متصفح أنترنت أكسبلورر Dim HTMLDoc As HTMLDocument Dim oBrowser As InternetExplorer Dim oHTML_Element As IHTMLElement Dim sURL As String On Error GoTo Err_Clear sURL = "https://www.officena.net/ib/login/" Set oBrowser = New InternetExplorer oBrowser.Silent = True oBrowser.Navigate sURL oBrowser.Visible = True Do ' Wait till the Browser is loaded Loop Until oBrowser.ReadyState = READYSTATE_COMPLETE Set HTMLDoc = oBrowser.Document HTMLDoc.all.auth.Value = Me.str_UserName HTMLDoc.all.Password.Value = Me.str_Password HTMLDoc.getElementById("elSignIn_submit").Click ' oBrowser.Refresh ' Refresh If Needed Err_Clear: If Err <> 0 Then 'Debug.Assert Err = 0 Err.Clear Resume Next End If فتح موقع أوفيسنا.rar

كلام الاستاذ صحيح ، ولكن : ممكن عمل التالي (انا اكتب واعرض الكود حاليا وبدون التأكد منه ، فرجاء التأكد) ، تقدر تعمل التالي : اسم التقرير rpt_1 ، واسم الحقل Text1 ، ومن زر فتح التقرير ، من النموذج : docmd.openreport "rpt_1", acviewPreview Reports!rpt_1!Text1 = "نحن نقوم بالتجربة على البطاقة رقم " & me.ID جعفر

للتو انتبهت أنك عدلت على كود السائل ، وللتو عرفت ما يريد من الكود لأن العربي كان غير مقروء ، وتعديلي كان "عمياني" بدون أن أفهم الرسائل 🙂 لقد قمت بتصميم نموذج وإضافة Checkbox باسم dd ولصق كود السائل في حدث AfterUpdate وبعد أن أصبحت نصوص الرسائل مقروءة ، أنصح السائل أن يعمل زرين أحدهما للإضافة وأخر للحذف أفضل من هذه الطريقة الغريبة!! ، وربما له هدف لا نعرفه من هذه الطريقة فإذا عرف السبب بطل العجب.

وعليكم السلام فيما أعلم لا يمكن ذلك . لأن التقارير مرتبطة بالجدول أو الاستعلام .

تفضل يمكنك استخدام هذا الكود Sub Remove_Duplicates() Range("f5:f1000").RemoveDuplicates Columns:=1, Header:=xlYes End Sub ولو حابب حذف المكرر بدون أكواد ..يمكنك هذا بعد تحديد العمود الذى تريد حذف المكرر منه.ثم الذهاب الى قائمة Data ثم الضغط على Remove Duplicates ... وهذا موضح بالصورة المرفقة Remove Duplicate.xlsm

وعليكم السلام اخوي صالح 🙂 هذه الخاصية موجودة في الاكسس فقط (مثل Lookup في الجدول) ، فيجب عليك ان تتعامل معهم بطريقة اخرى ، قبل ان تنتقل الى SQL Server 🙂 احد الطرق هي ان تجعل هذه القيم في جدول آخر ، وفي النموذج تعامله كنموذج فرعي 🙂 منقول ومترجم من: https://answers.microsoft.com/en-us/msoffice/forum/all/access-multivalue-field-convert-to-ms-sql/05e4ebe9-d919-44c6-bf76-efe47e0d5cae جعفر

وعليكم السلام-لا يمكن عمل أكثر من ذلك 1برنامج.xlsm

السلام عليكم لقد قمت بتصحيح الكود كما جاء في الرابط: سأضع المثال كما أمرتم. جزاكم الله كل خير أستاذ @jjafferr لقد كتبت الكود السابق خطأ، في المرفق الفكرة كما أردت طرحها. Database1.accdb

همم ، وانا وقعت في هذا الخطأ ، يمكن لأني كنت دايخ😁 شكرا لك اخي الهاوي 🙂 جعفر

على العموم ، انا مجهز البخور ، فالجماعة جاهزين معاي 😁

شو السالفة !! اشوف متفقين عليّ 😁 لا تكونوا متراهنين ، وتنتظرون تشوفون من بيفوز !! انا آسف ، ما ممكن اتابع ، إلا بأن اشوف ملف التلاميذ كلهم ، وإلا فمافيه فائدة 🙂 جعفر

توقعاتي صحيحة ..... ههههههه .... لانه لا يعقل ان نعمل كود لطالب واحد .....

اعتقد قراءة لفكر فايز ( اريدها لأكثر من سجل ) ........ صح يا استاذ / فايز

يا ريت ترفق لنا مثال حتى نستفيد 🙂 جعفر

السلام عليكم لقد قدم أساتذتي -جزاهم الله كل خير-الجواب على هذه المسألة. وأضيف من تجربتي: يمكنكم ذلك بجعل تصميم النموذج هو تصميم التقرير- فعلياً لا وجود للتقرير- ومن ثم فإنك تطبع النموذج نفسه. أو بإضافة عنصر تحكم نموذج تجعل مصدره التقرير من خلال الكود: Me.subFormName.Sourceobject "ReportName.rep"= عندها سيظهر التقرير ضمن النموذج وستتمكن من تدارك التعديلات قبل الطباعة ودون الخروج من النافذة. الشكر للأستاذ رمهان فمنهم تعلمت طريقة عرض التقرير ضمن النموذج.

في الواقع المنتديات عالم بذاته ، وبالخصوص المنتديات العربية ، ومختلف عن عالمنا الذي نعيش فيه ، وشوي شوي بدأت اتاقلم عليه ، ومازلت احاول 🙂 فأهلا وسهلا بك في التأقلم في هذا العالم 🙂 جعفر

احسنت استاد سليم نفعنا الله بعلمك هذا المطلوب

الف شكر للجميع واعتذر على التأخير بأعد ملف اكسل بإسم فورم اكسل للبحث عن ايات القران الكريم وتفسيره ورقم الجذء والصفحة

طيب فـــين الجدول الذى تتحدث عنه , من فضلك ارفع ملف موضح عليه المطلوب بكل دقة حيث ليس هناك عمل يقوم على التخمين ونبهنا من قبل مئات المرات ... لا تنجح اى مشاركة الا برفع ملف موضح عليه المطلوب بكل دقة وذلك تجنباً لعدم اهدار وقت الأساتذة دون جدوى او اهمية وبما انك لم تقم برفع ملف , فما هو السبب فى عدم استخدامك خاصية البحث بالمنتدى فبه طلبك : تحديد صف وعمود الخلية النشطة (تلوين العمود والصف باستخدام التنسيق الشرطي) كود تلوين صف نشط وهذا ايضا رابط خارجى كود لتلوين الخلية الفعالة – Active Cell

ماشاء الله هذا هو المطلوب بالفعل جزاك الله خيرا اشكرك من كل قلبى بارك الله فيك

'طباعة1.xlsm

السلام عليكم تظهر هذه الرسالة عندما تكون قاعدة البيانات تالفة تحياتي

لا شكر على واجب أخي. بارك الله فيك و جزاك الله خيرا اذا اكتفيت بالإجابة .حدد كأفضل إجابة حتى يتم غلق الموضوع

وعليكم السلام اخي الفاضل 🙂 واهلا وسهلا بك في المنتدى 🙂 الخطأ عندك في السطر الاول ، حيث انه لما تنقر على كائن صح/خطأ ، فعلامة الصح قيمتها -1 ، وعلامة بدون صح قيمتها 0 ، فعليه يصبح الكود : If Me.dd = -1 Then ولكن ، ايش رأيك في هذ التنسيق ، بحيث بإستعمال TAB الكيبورد ننسق الكود ، فتصبح قراءة الكود سهله ، ونعرف كل مجموعة وين بدايتها ووين نهايتها : If Me.dd = -1 Then Dim t t = MsgBox("?? ??E ?E??I ?? ?UEE? ??? ?C?E C????C? ?? C??CE??E?", vbYesNo, "??? C????C? ?? C??CE??E") If t = vbYes Then DoCmd.SetWarnings False DoCmd.OpenQuery "C?E??C? ??? ?CE??E" Me.dd = 0 DoCmd.SetWarnings True ElseIf t = vbNo Then MsgBox "E? C?E?C?? ?? C????" End If ElseIf Me.dd = 0 Then Dim r r = MsgBox("?? ??E ?E??I ?? ?UEE? ??C?E C???? ???CE??E?", vbYesNo, "??U C????") If r = vbYes Then DoCmd.SetWarnings False DoCmd.OpenQuery "Q1" DoCmd.OpenQuery "Q2" Me.dd = 1 DoCmd.SetWarnings True ElseIf r = vbNo Then MsgBox "E? C?E?C?? ?? C???U" DoCmd.CancelEvent End If End If جعفر

اولا : احذف هذا السطر لا تحتاجه appAccess.Visible = False ثم عدل في بعض خصائص النموذج للقاعدتين الاخرى ....... حتى تصل للنتيجة المرغوبة .....

السلام عليكم ورحمة الله ضع هذا الكود فى حدث ThisWorkbook Private Sub Workbook_SheetActivate(ByVal Sh As Object) For i = 1 To Sheets.Count Sheets(i).Range("A1").Value = i Next End Sub

بعد اذن اخي الرائد هذا الماكرو Option Explicit Sub Join_data() If ActiveSheet.Name <> "Salim" Then Exit Sub Dim i%, Dic As Object, k, my_key Set Dic = CreateObject("Scripting.Dictionary") Cells(3, "H").CurrentRegion.Clear i = 3 Do Until Cells(i, "E") = vbNullString k = Cells(i, "F") If Not Dic.Exists(Cells(i, "E").Value) Then Dic(Cells(i, "E").Value) = k Else Dic(Cells(i, "E").Value) = Dic(Cells(i, "E").Value) & "," & k End If i = i + 1 Loop Cells(3, "H").Resize(Dic.Count) = Application.Transpose(Dic.keys) i = 3 For Each my_key In Dic.keys Cells(i, "I") = Dic(my_key) & "." i = i + 1 Next my_key Set Dic = Nothing With Cells(3, "H").CurrentRegion .Interior.ColorIndex = 6 .Borders.LineStyle = 1 .InsertIndent 1 End With End Sub الملف للمعاينة مرفق talabia_SL.xlsm

حسب فهمي لطلبك: 75%.xlsx

هذا الكود يقوم باخفاء الاسطر التي لا توجد بها أي قيم فى العمود B و يعتمد علي تسمية مجال محدد يسمي Myrange لتحديد عدد الصفوف المطلوب ادراء هذه العملية عليها Sub hidemptyRow_basedonthiscol() ' ' hideemptyRow Macro ' Macro recorded 25-12-02 by taher to hide empty rows in aselection Application.ScreenUpdating = False Application.Goto Reference:="myrange" Myrows = Selection.Rows.Count origraw = Myrows ActiveCell.Select For i = 1 To Myrows - 1 If ActiveCell.Value <> "" Then ActiveCell.Offset(1, 0).Activate If ActiveCell.Value = "" Then ActiveCell.EntireRow.Hidden = -1 ActiveCell.Offset(1, 0).Activate Myrows = Myrows - 1 End If Application.StatusBar = " checking ...." & _ Format(i / origraw, "0.0%") & " Please Wait......." Next i Application.ScreenUpdating = True Application.StatusBar = False End Sub[/sql] HideEmptyRows.zip

لا أعلم اذا كان هذا المطلوب Education_Job.xlsx

ضع كلمة report اولا وكاتالي : Private Sub أمر4_Click() Me.sh.SourceObject = "report.rep" End Sub بالتوفيق

ماشاء الله عليك اخوي صالح ، كفيت ووفيت ، وما بقيت لي شئ اكتبه التنسيق: وذلك بإستخدام زر الـ Tab (لتحريك السطر Indenting) ، و زر Enter (للإنتقال الى السطر التالي) تنسيق وتجميع مجموعات اللـ IF مهم ، وكلما كان تنسيقك افضل ، كلما قلّت اخطاءك ، وكلما استطعت الوصوت للخطأ بسرع في الصور كود لبرنامج أحد الاعضاء (واعتذر مسبقا من صاحب الاكواد) ، لاحظ طريقة عرض الكود ، بدون تنسيق ، وصعوبة معرفة بداية ونهاية الشرط IF : قبل التنسيق وسهولة القراءة بعد التنسيق . اما الكود التالي ، فذكرني بالكاريكاتير "ابحث عن فضولي" ، وهنا نبحث عن بداية ونهاية الشرط IF : . وتم تعديل التنسيق (تغيير الكود هو للتوضيح) الى: . هناك شيئين في التنسيق ، الاول: لاحظ انه من السهل معرفة بداية ونهاية كل شرط ، وحتى الشروط المتداخلة في الشرط الاصلي ، اصبح من السهل معرفة بدايتها ونهايتها ، ونافذة الكود تخبرنا 1: على اي سطر نحن (Line, Ln) ، و 2: في اي عمود (Column, Col) ، مما يساعدنا في عملية التنسيق . ثانيا: لاحظ اني عندما اقفل الجملة الشرطية End If ، فاني اكتب تعليق خلفها ، وهذا التعليق مأخوذ من جزء من بداية الشرط IF ، هذا يسهل عليّ كثيرا معرفة بداية ونهاية الجملة الشرطية: . جعفر

وعليكم السلام ولا احراج ولا حاجه يا ابانا الغالى كنت قد طلبت من الاستاذ محمد طاهر فتح الاعجابات وقيل لى سننظر فى الامر وقد زادوها من 10 باليوم الى 28 اعجاب جزاهم الله كل خير

اللهم أمين يا ابو اسيل ومن اجلك عيونكم وانا بالمحل الان اشحنلكم كمان تامرونى ياغلى الخلان

وعليكم السلام غير سطر الاول في الكودالى: هذا اذا كان تنسيق (رقم السجل) رقم sf="[رقم السجل]="&[رقم السجل] اوغيره الى: sf="[رقم السجل]='"&[رقم السجل]&"'" هذا اذا كان تنسيق (رقم السجل) نص و تأكد ان اسم حقل رقم السجل على نفس اسم في النموذج

أشكرك الأخ الغالى ياسر على ذوقك وسعة صدرك ودائما للامام وسنكون دائما افضل من الأجانب طالما يوجد الحب والتعاون الذى لاقيتة فى هذا المنتدى الرائع ومنك ومن جميع الأخوة للجميع كل الشكر

الأخ الحبيب ياسر اولا اشكرك على ردك وعلى مساعدتك لى وثانيا بعتذر لك ولكل اعضاء المنتدى الأعزاء اذا كان ردى غير مناسب لكنى لم أقصد الإساءة لأحد والله أعلم.انا بعتذر مرة أخرى اما بالنسبة لحل المشكله التى كانت تواجهنى فقد توصلت لحل فى أحد المواقع الأجنبية وتوصلت لحل المشكلة وهى تغيير إمتداد الملف من xlsm إلى xls أو xlsx لان الإمتداد الاول يتعارض مع عمل الماكرو لو تم عمل حماية للملف وبعد التجربة تم حل المشكلة . للمرة الثانية اشكرك اخى الحبيب والشكر واصل لكل أعضاء المنتدى المحترمين

أخي الحبيب بلاش الردود التي تجعل قاريء الموضوع حتى لو كان عنده حل ما يقدموش بسبب الطلب (الموضوع صعب اوى كدة عموما الشكر لجميع اعضاء المنتدى الكرام) إنت شايف إن دا رد.... ولذلك لاحظت أنه لم يرد عليك أي أحد .... عموما يا أخي الغالي تفضل الملف التالي (ملف REG) إن شاء المولى سيحل المشكلة ExcelBypassEncryptedMacroScan.rar

و هذا الكود المناظر لحذف الاسطر و هنا لم يتم اختيار مجال باسم محدد ، و لكن يتم التنفيذ بناء علي اختيار المستخدم للخلاية selection Sub deleteemptyRow() ' ' deleteemptyRow Macro ' Macro recorded 19/07/2000 by taher to delete empty rows in aselection Application.ScreenUpdating = False Dim MyRow As Long, origraw As Long ' Z As String MyRow = Selection.Rows.Count origraw = MyRow ActiveCell.Select 'MsgBox MyRow For i = 1 To MyRow If ActiveCell.Value <> "" Then ActiveCell.Offset(1, 0).Activate If ActiveCell.Value = "" Then ActiveCell.EntireRow.Delete MyRow = MyRow - 1 End If Application.StatusBar = "Parsing / deleting ...." & _ Format(i / origraw, "0.0%") & " Please Wait......." Next i Application.ScreenUpdating = True Application.StatusBar = False End Sub[/sql] DeleteemptyRows.zip