Posts by Qaiyum

Qaiyum · Dec 2nd 2014

Re: App Crash while running Macro

Quote from ashu1990;732825

this problem is related to your PC not with excel macros take a look at this

https://social.technet.microso…m=itprovistaannouncements

Thanks for your great help........

Qaiyum · Dec 2nd 2014

Hi Friends,

I have one macro which was running successfully through out the year. But since from few days I am getting App Crash Error. Unable to understand the issue. Can you please help me in this regards.

Following is the Error
Problem Even : APPCRASH
Application Name : Excel.exe
Fault Module Name: StackHash_8f73
Fault Module Version: 6.1.7601.17725
Exception Code:c0000374
Exception Offset : 000ce6c3

Do let me know any additional information required.

Qaiyum · Feb 27th 2014

Re: Excel Sub Function Error

Thank you dear... It was great help....

Qaiyum · Feb 26th 2014

Re: Excel Sub Function Error

Hi Scott,

Still I am having same Error. Actually I want to copy an excel range and past into the mail body. Please suggest any further modification in code.
Thanks for your valuable time.

Qaiyum · Feb 26th 2014

Re: Excel Sub Function Error

When I defined with Dim code but my mail body is coming blank.

Qaiyum · Feb 26th 2014

Re: Excel Sub Function Error

I am error in rangetoHTML in below code

HTML

With olMail
                .To = StringTo
                .CC = StringCC
                .BCC = StringBCC
                .Subject = ActiveSheet.Cells(myCell.Row, "U").Value
                
                .HTMLBody = "<HTML> <br> </br> </HTML>" & "<html><b>Hi,</b></html>" & "<HTML> <br> </br> </HTML>" _
                & " <html><b> " _
                & "Please find below summary on Cash Indent and Cash Received.</b></html>" _
                & "<HTML> <br> </br> </HTML>" & "<html><b><u> If any discrepancies observed, " _
                & "please highlight us for further investigations & rectifications. </b></u> </html>" & _
                "<HTML> <br> </br> </HTML>" & rangetoHTML(rng) & "<HTML> <br> </br> </HTML>" & _
                "<html><b>Thanks & Regards</b></html>" & "<HTML> <br> </br> </HTML>" & "<b> NCR Corporation (Cash Team) </b>"
                .display

Display More

Qaiyum · Feb 26th 2014

Hi,

I am getting an Error while sending Mails. It is showing me Sub or Function not defined.
Please Help

Below is the code

HTML

Sub C_Gen()
    Dim Curr, Mac As Workbook
    Dim wbData, M, Nac As Worksheet
    Dim wsCrit As Worksheet
    Dim wbNew As Worksheet
    Dim bng As Range
    Dim lastrow As Long
    Dim Cur As Workbook
    Dim QS As Worksheet
    Dim a, b, c, D, Name, PT, x, y, z
    Dim StringTo As String, StringCC As String, StringBCC As String
    Dim AB
    Dim ShArr() As String, FArr() As String, strDate As String
    Dim myCell As Range, cell As Range, rng As Range, Fname As String, Fname2 As String
    Dim wb As Workbook, sh As Worksheet
    Dim DefPath As String
    Dim olApp As Object
    Dim olMail As Object
    Dim FileExtStr As String




    Dim ToArray As Variant
    Dim CCArray As Variant
    Dim BCCArray As Variant




    Dim StringFileNames As String
    Dim StringSheetNames As String
    Dim FileNamesArray As Variant
    Dim SheetNamesArray As Variant
    Dim I As Long, S As Long, F As Long
    Dim WrongData As Boolean
    
    
    
    Set Curr = Application.ActiveWorkbook
    Sheets("M").Select
    Set M = Application.ActiveSheet
            
    M.Activate
    
     
    Curr.Activate
        
    Set Nac = Application.ActiveSheet
                
    Nac.Activate
    Set wsCrit = Worksheets.Add
    Nac.Activate
    lastrow = Range("A" & Rows.Count).End(xlUp).Row
    Nac.Range("A2:A3004").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsCrit.Range("A1"), Unique:=True
     
    Set bng = wsCrit.Range("A2")
    
        
    While bng.Value <> ""
        Set wbNew = Worksheets.Add
        
        Nac.Range("A2:P" & lastrow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=bng.Offset(-1).Resize(2), CopyToRange:=wbNew.Range("A1"), Unique:=True
        wbNew.Name = "TP"
        Range("B2:P12").Select
        Selection.Copy
        Worksheets("E").Select
        Range("A3").Select
        Selection.PasteSpecial Paste:=xlPasteValues
        
        bng.EntireRow.Delete
        Set bng = wsCrit.Range("A2")
        Application.DisplayAlerts = False
        Sheets("TP").Delete
        
        Application.DisplayAlerts = True
        
        If Len(ThisWorkbook.Path) = 0 Then
        MsgBox "This macro will only work if the file is Saved once", 48, "Qaiyum Shaikh"
        Exit Sub
    End If




    If ActiveSheet.ProtectContents = True Or ActiveWindow.SelectedSheets.Count > 1 Then
        MsgBox "This macro will not work if the Qaiyum is " & _
               "protected or if you have more then sheet selected(grouped)", 48, "Qaiyum"
        Exit Sub
    End If




    'Set folder where we save the temporary files
    DefPath = Application.DefaultFilePath
    If Right(DefPath, 1) <> "\" Then
        DefPath = DefPath & "\"
    End If




    




    'Set reference to Outlook and turn of ScreenUpdating and Events
    Set olApp = CreateObject("Outlook.Application")
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    Range("P2").Select
    'Set cells with Red interior color to no fill(cells with wrong data)




    'Set rng to the first column of the table
    Set rng = ActiveSheet.Range("P3")
    




    For Each myCell In rng




        'Create mail if "Yes " in column A
        If LCase(myCell.Value) = "yes" Then




            StringTo = "": StringCC = "": StringBCC = ""
            S = 0: F = 0
            Erase ShArr: Erase FArr




            'Set Error Boolean to False
            WrongData = False




            'Check to Mail addresses in column D
            If Trim(ActiveSheet.Cells(myCell.Row, "Q").Value) <> "" Then
                StringTo = ActiveSheet.Cells(myCell.Row, "Q").Value
                ToArray = Split(StringTo, Chr(10), -1)
                StringTo = ""




                For I = LBound(ToArray) To UBound(ToArray)
                    If ToArray(I) Like "?*@?*.?*" Then
                        StringTo = StringTo & ";" & ToArray(I)
                    End If
                Next I
            End If




            'Check to Mail addresses in column E
            If Trim(ActiveSheet.Cells(myCell.Row, "R").Value) <> "" Then
                StringCC = ActiveSheet.Cells(myCell.Row, "R").Value
                CCArray = Split(StringCC, Chr(10), -1)
                StringCC = ""




                For I = LBound(CCArray) To UBound(CCArray)
                    If CCArray(I) Like "?*@?*.?*" Then
                        StringCC = StringCC & ";" & CCArray(I)
                    End If
                Next I
            End If




            'Check to Mail addresses in column F
            If Trim(ActiveSheet.Cells(myCell.Row, "S").Value) <> "" Then
                StringBCC = ActiveSheet.Cells(myCell.Row, "S").Value
                BCCArray = Split(StringBCC, Chr(10), -1)
                StringBCC = ""




                For I = LBound(BCCArray) To UBound(BCCArray)
                    If BCCArray(I) Like "?*@?*.?*" Then
                        StringBCC = StringBCC & ";" & BCCArray(I)
                    End If
                Next I
            End If




            If StringTo = "" And StringCC = "" And StringBCC = "" Then
                ActiveSheet.Cells(myCell.Row, "D").Resize(, 3).Interior.ColorIndex = 3
                WrongData = True
            End If




            'Check the other files that you want to attach in column H
            If Trim(ActiveSheet.Cells(myCell.Row, "T").Value) <> "" Then
                StringFileNames = ActiveSheet.Cells(myCell.Row, "T").Value
                FileNamesArray = Split(StringFileNames, Chr(10), -1)




                For I = LBound(FileNamesArray) To UBound(FileNamesArray)
                    On Error Resume Next
                    If FileNamesArray(I) <> "" Then
                        If Dir(FileNamesArray(I)) <> "" Then
                            If Err.Number = 0 Then
                                F = F + 1
                                ReDim Preserve FArr(1 To F)
                                FArr(F) = FileNamesArray(I)
                            Else
                                Err.Clear
                                ActiveSheet.Cells(myCell.Row, "T").Interior.ColorIndex = 3
                                WrongData = True
                            End If
                        Else
                            ActiveSheet.Cells(myCell.Row, "T").Interior.ColorIndex = 3
                            WrongData = True
                        End If
                    End If
                    On Error GoTo 0
                Next I
            End If




            'Not create the mail if there are Errors in the row (wrong sheet or file names or no mail addresses)
            If WrongData = True Then GoTo MailNot
    
    Set rng = Sheets("E").Range("A1:O3").SpecialCells(xlCellTypeVisible)




'            Set AB = Me.Range("O2:Z4").SpecialCells(xlCellTypeVisible)
            On Error Resume Next
            Set olMail = olApp.CreateItem(0)
            With olMail
                .To = StringTo
                .CC = StringCC
                .BCC = StringBCC
                .Subject = ActiveSheet.Cells(myCell.Row, "U").Value
                
                .HTMLBody = "<HTML> <br> </br> </HTML>" & "<html><b>Hi,</b></html>" & "<HTML> <br> </br> </HTML>" _
                & " <html><b> " _
                & "Please find below summary on Cash Indent and Cash Received.</b></html>" _
                & "<HTML> <br> </br> </HTML>" & "<html><b><u> If any discrepancies observed, " _
                & "please highlight us for further investigations & rectifications. </b></u> </html>" & _
                "<HTML> <br> </br> </HTML>" & rangetoHTML(rng) & "<HTML> <br> </br> </HTML>" & _
                "<html><b>Thanks & Regards</b></html>" & "<HTML> <br> </br> </HTML>" & "<b> NCR Corporation (Cash Team) </b>"
                .display
                
                
                'If S <> 0 Then .Attachments.Add Fname




                If F > 0 Then
                    For I = LBound(FArr) To UBound(FArr)
                        .Attachments.Add FArr(I)
                    Next I
                End If




                'Set Importance  0 = Low, 2 = High, 1 = Normal
                If LCase(ActiveSheet.Cells(myCell.Row, "V").Value) = "yes" Then
                    .Importance = 2
                End If




                'Display the mail or send it directly, see cell C3
                If LCase(ActiveSheet.Range("Q1").Value) = "yes" Then
                    .display
                Else
                    .Send
                End If








            End With




            If S = -1 Then Kill Fname2
            Kill Fname
            On Error GoTo 0




            Set olMail = Nothing




        End If
MailNot:
    Next myCell




    If LCase(ActiveSheet.Range("V3").Value) = "no" Then
        MsgBox "The macro is ready and if correct the mail or mails are created." & vbNewLine & _
               "If you see Red cells in the table then the information in the cells is " & vbNewLine & _
               "not correct. For example there is a sheet or filename that not exist." & vbNewLine & _
               "Note: It will not create a Mail of the information in a row with a " & vbNewLine & _
               "Red cell or cells.", 48, "Macro Help"
    End If








    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With




    Set olApp = Nothing
        
        
        Nac.Activate
    Wend
End




End Sub

Display More

Qaiyum · Feb 26th 2014

Re: Run Another Macro

Thanks a Ton... Will do it

Qaiyum · Feb 26th 2014

Re: Run Another Macro

Dear Stephen,

Thanks for the information, I have created another macro where my problem was resolved with the code given by you.
However I have different Issue that I am not able to find what is wrong because I am getting a Error "Sub or Function not defined"
I am getting Error on below code in Error in "rangetoHTML"

HTML

[/B][/COLOR].HTMLBody = "<HTML> <br> </br> </HTML>" & "<html><b>Hi,</b></html>" & "<HTML> <br> </br> </HTML>" _                & " <html><b> " _                & "Please find below summary on Cash Indent and Cash Received.</b></html>" _                & "<HTML> <br> </br> </HTML>" & "<html><b><u> If any discrepancies observed, " _                & "please highlight us for further investigations & rectifications. </b></u> </html>" & _                "<HTML> <br> </br> </HTML>" & rangetoHTML(rng) & "<HTML> <br> </br> </HTML>" & _                "<html><b>Thanks & Regards</b></html>" & "<HTML> <br> </br> </HTML>" & "<b> NCR Corporation (Cash Team) </b>"[COLOR=#3E3E3E][B]

[/B][/COLOR]

Qaiyum · Feb 26th 2014

Re: Run Another Macro

Hi,
Thanks, But my problem is that the code was placed in Particular Sheet VB Editor Wizard not in any module. Hence unable to run that macro.
Please help.

Qaiyum · Feb 26th 2014

Hi,

I have One Macro in one Sheet.

I want to run that Macro from another Macro, please help me in code for this.

Thanks & regards,
Qaiyum Shaikh

Qaiyum · Dec 27th 2013

Hi,

I have a code which open Internet explore and logging into the system of my vendor.
Problem is that when ever macro clicks on Submit button it will pop up a window asking for OK or Cancel.

Can any one help me on how to accept OK button automatically?

Thanks in advance.

Regards,
Qaiyum Shaikh

Qaiyum · Nov 28th 2013

Re: New Workbook with xlsx

Hi,

So sorry, please find below is the correct code.
After all 31 sheets consolidated in "RMIS" Sheet the data will be around 1500000 Plus. And due the new opening workbook is having only 65536 rows paste function is failed.

Once again sorry for wrong code paste:

Code

[COLOR=#0000ff]Private[/COLOR] [COLOR=#0000ff]Sub[/COLOR] CommandButton11_Click() 
    [COLOR=#0000ff]Dim[/COLOR] x [COLOR=#0000ff]As[/COLOR] [COLOR=#0000ff]Integer[/COLOR] 
    [COLOR=#0000ff]Dim[/COLOR] RIM, DMI 
    [COLOR=#0000ff]Set[/COLOR] RIM = Application.ActiveWorkbook 
    Worksheets("RMIS").Select 
    ActiveSheet.Unprotect Password:="SBIMIS" 
     
    Worksheets("01").Select 
    Range("d5:cx5004").Select 
    Selection.Copy 
    Range("d5").Select 
    Worksheets("RMIS").Select 
    x = Range("cv1").Value + 1 
    Range("A" & x).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Worksheets("02").Select 
    Range("d5:cx5004").Select 
    Selection.Copy 
    Range("d5").Select 
    Worksheets("RMIS").Select 
    x = Range("cv1").Value + 1 
    Range("A" & x).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Worksheets("03").Select 
    Range("d5:cx5004").Select 
    Selection.Copy 
    Range("d5").Select 
    Worksheets("RMIS").Select 
    x = Range("cv1").Value + 1 
    Range("A" & x).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Worksheets("04").Select 
    Range("d5:cx5004").Select 
    Selection.Copy 
    Range("d5").Select 
    Worksheets("RMIS").Select 
    x = Range("cv1").Value + 1 
    Range("A" & x).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Worksheets("05").Select 
    Range("d5:cx5004").Select 
    Selection.Copy 
    Range("d5").Select 
    Worksheets("RMIS").Select 
    x = Range("cv1").Value + 1 
    Range("A" & x).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Worksheets("06").Select 
    Range("d5:cx5004").Select 
    Selection.Copy 
    Range("d5").Select 
    Worksheets("RMIS").Select 
    x = Range("cv1").Value + 1 
    Range("A" & x).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Worksheets("07").Select 
    Range("d5:cx5004").Select 
    Selection.Copy 
    Range("d5").Select 
    Worksheets("RMIS").Select 
    x = Range("cv1").Value + 1 
    Range("A" & x).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Worksheets("08").Select 
    Range("d5:cx5004").Select 
    Selection.Copy 
    Range("d5").Select 
    Worksheets("RMIS").Select 
    x = Range("cv1").Value + 1 
    Range("A" & x).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Worksheets("09").Select 
    Range("d5:cx5004").Select 
    Selection.Copy 
    Range("d5").Select 
    Worksheets("RMIS").Select 
    x = Range("cv1").Value + 1 
    Range("A" & x).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Worksheets("10").Select 
    Range("d5:cx5004").Select 
    Selection.Copy 
    Range("d5").Select 
    Worksheets("RMIS").Select 
    x = Range("cv1").Value + 1 
    Range("A" & x).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Worksheets("11").Select 
    Range("d5:cx5004").Select 
    Selection.Copy 
    Range("d5").Select 
    Worksheets("RMIS").Select 
    x = Range("cv1").Value + 1 
    Range("A" & x).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Worksheets("12").Select 
    Range("d5:cx5004").Select 
    Selection.Copy 
    Range("d5").Select 
    Worksheets("RMIS").Select 
    x = Range("cv1").Value + 1 
    Range("A" & x).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Worksheets("13").Select 
    Range("d5:cx5004").Select 
    Selection.Copy 
    Range("d5").Select 
    Worksheets("RMIS").Select 
    x = Range("cv1").Value + 1 
    Range("A" & x).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Worksheets("14").Select 
    Range("d5:cx5004").Select 
    Selection.Copy 
    Range("d5").Select 
    Worksheets("RMIS").Select 
    x = Range("cv1").Value + 1 
    Range("A" & x).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Worksheets("15").Select 
    Range("d5:cx5004").Select 
    Selection.Copy 
    Range("d5").Select 
    Worksheets("RMIS").Select 
    x = Range("cv1").Value + 1 
    Range("A" & x).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Worksheets("16").Select 
    Range("d5:cx5004").Select 
    Selection.Copy 
    Range("d5").Select 
    Worksheets("RMIS").Select 
    x = Range("cv1").Value + 1 
    Range("A" & x).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Worksheets("17").Select 
    Range("d5:cx5004").Select 
    Selection.Copy 
    Range("d5").Select 
    Worksheets("RMIS").Select 
    x = Range("cv1").Value + 1 
    Range("A" & x).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Worksheets("18").Select 
    Range("d5:cx5004").Select 
    Selection.Copy 
    Range("d5").Select 
    Worksheets("RMIS").Select 
    x = Range("cv1").Value + 1 
    Range("A" & x).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Worksheets("19").Select 
    Range("d5:cx5004").Select 
    Selection.Copy 
    Range("d5").Select 
    Worksheets("RMIS").Select 
    x = Range("cv1").Value + 1 
    Range("A" & x).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Worksheets("20").Select 
    Range("d5:cx5004").Select 
    Selection.Copy 
    Range("d5").Select 
    Worksheets("RMIS").Select 
    x = Range("cv1").Value + 1 
    Range("A" & x).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Worksheets("21").Select 
    Range("d5:cx5004").Select 
    Selection.Copy 
    Range("d5").Select 
    Worksheets("RMIS").Select 
    x = Range("cv1").Value + 1 
    Range("A" & x).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Worksheets("22").Select 
    Range("d5:cx5004").Select 
    Selection.Copy 
    Range("d5").Select 
    Worksheets("RMIS").Select 
    x = Range("cv1").Value + 1 
    Range("A" & x).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Worksheets("23").Select 
    Range("d5:cx5004").Select 
    Selection.Copy 
    Range("d5").Select 
    Worksheets("RMIS").Select 
    x = Range("cv1").Value + 1 
    Range("A" & x).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Worksheets("24").Select 
    Range("d5:cx5004").Select 
    Selection.Copy 
    Range("d5").Select 
    Worksheets("RMIS").Select 
    x = Range("cv1").Value + 1 
    Range("A" & x).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Worksheets("25").Select 
    Range("d5:cx5004").Select 
    Selection.Copy 
    Range("d5").Select 
    Worksheets("RMIS").Select 
    x = Range("cv1").Value + 1 
    Range("A" & x).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Worksheets("26").Select 
    Range("d5:cx5004").Select 
    Selection.Copy 
    Range("d5").Select 
    Worksheets("RMIS").Select 
    x = Range("cv1").Value + 1 
    Range("A" & x).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Worksheets("27").Select 
    Range("d5:cx5004").Select 
    Selection.Copy 
    Range("d5").Select 
    Worksheets("RMIS").Select 
    x = Range("cv1").Value + 1 
    Range("A" & x).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Worksheets("28").Select 
    Range("d5:cx5004").Select 
    Selection.Copy 
    Range("d5").Select 
    Worksheets("RMIS").Select 
    x = Range("cv1").Value + 1 
    Range("A" & x).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Worksheets("29").Select 
    Range("d5:cx5004").Select 
    Selection.Copy 
    Range("d5").Select 
    Worksheets("RMIS").Select 
    x = Range("cv1").Value + 1 
    Range("A" & x).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Worksheets("30").Select 
    Range("d5:cx5004").Select 
    Selection.Copy 
    Range("d5").Select 
    Worksheets("RMIS").Select 
    x = Range("cv1").Value + 1 
    Range("A" & x).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Worksheets("31").Select 
    Range("d5:cx5004").Select 
    Selection.Copy 
    Range("d5").Select 
    Worksheets("RMIS").Select 
    x = Range("cv1").Value + 1 
    Range("A" & x).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Cells.copy
     
    Workbooks.Add


    [COLOR=#0000ff]Set[/COLOR] DMI = Application.ActiveWorkbook 
    Range("a1").Select
    Selection.PasteSpecial Paste:=xlPastevalues
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    RIM.Activate 
    Range("a2").Select 
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select 
    Selection.EntireRow.Delete 
    ActiveSheet.Protect Password:="SBIMIS" 
    DMI.Activate 
    Range("CV2").Select 
    ActiveCell.FormulaR1C1 = "=IF(R[-1]C[-98]=RC[-98],R[-1]C[-11]-RC[-17],""NEW"")" 
    Range("CV2").Select 
    Selection.Copy 
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select 
    ActiveSheet.Paste 
    Application.CutCopyMode = [COLOR=#0000ff]False[/COLOR] 
    Range("CV1").Select 
    Selection.ClearContents 
    Range("CW1").Select 
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-1],"">0"")+COUNTIF(C[-1],""<0"")" 
    MsgBox ("Total Opening closing Mismatch for current month = " & Range("CW1").Value) 
    [COLOR=#0000ff]End[/COLOR] 
[COLOR=#0000ff]End Sub[/COLOR]

Display More

Qaiyum · Nov 28th 2013

Re: New Workbook with xlsx

Hi,

When ever I Create New workbook by Pressing "Control N" the file open and it is having 65536 rows only, means Excel 97-2003 version (xls type). And I want to copy & Paste from 30 different sheet which around 150000/- rows +, it is not possible that code will paste data and will fail when it arrived to 65536 rows level.

What I want when my code create new file it should be having 1048576 rows, i.e. Excel 2010 version.
Please help... Hopes this clarifies my requirement....

Code

Private Sub CommandButton11_Click()
Dim x As Integer
Dim RIM, DMI
Set RIM = Application.ActiveWorkbook
Worksheets("RMIS").Select
ActiveSheet.Unprotect Password:="SBIMIS"


Worksheets("01").Select
Range("d5:cx5004").Select
Selection.Copy
Range("d5").Select
Worksheets("RMIS").Select
x = Range("cv1").Value + 1
Range("A" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Worksheets("02").Select
Range("d5:cx5004").Select
Selection.Copy
Range("d5").Select
Worksheets("RMIS").Select
x = Range("cv1").Value + 1
Range("A" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Worksheets("03").Select
Range("d5:cx5004").Select
Selection.Copy
Range("d5").Select
Worksheets("RMIS").Select
x = Range("cv1").Value + 1
Range("A" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Worksheets("04").Select
Range("d5:cx5004").Select
Selection.Copy
Range("d5").Select
Worksheets("RMIS").Select
x = Range("cv1").Value + 1
Range("A" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Worksheets("05").Select
Range("d5:cx5004").Select
Selection.Copy
Range("d5").Select
Worksheets("RMIS").Select
x = Range("cv1").Value + 1
Range("A" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Worksheets("06").Select
Range("d5:cx5004").Select
Selection.Copy
Range("d5").Select
Worksheets("RMIS").Select
x = Range("cv1").Value + 1
Range("A" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Worksheets("07").Select
Range("d5:cx5004").Select
Selection.Copy
Range("d5").Select
Worksheets("RMIS").Select
x = Range("cv1").Value + 1
Range("A" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Worksheets("08").Select
Range("d5:cx5004").Select
Selection.Copy
Range("d5").Select
Worksheets("RMIS").Select
x = Range("cv1").Value + 1
Range("A" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Worksheets("09").Select
Range("d5:cx5004").Select
Selection.Copy
Range("d5").Select
Worksheets("RMIS").Select
x = Range("cv1").Value + 1
Range("A" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Worksheets("10").Select
Range("d5:cx5004").Select
Selection.Copy
Range("d5").Select
Worksheets("RMIS").Select
x = Range("cv1").Value + 1
Range("A" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Worksheets("11").Select
Range("d5:cx5004").Select
Selection.Copy
Range("d5").Select
Worksheets("RMIS").Select
x = Range("cv1").Value + 1
Range("A" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Worksheets("12").Select
Range("d5:cx5004").Select
Selection.Copy
Range("d5").Select
Worksheets("RMIS").Select
x = Range("cv1").Value + 1
Range("A" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Worksheets("13").Select
Range("d5:cx5004").Select
Selection.Copy
Range("d5").Select
Worksheets("RMIS").Select
x = Range("cv1").Value + 1
Range("A" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Worksheets("14").Select
Range("d5:cx5004").Select
Selection.Copy
Range("d5").Select
Worksheets("RMIS").Select
x = Range("cv1").Value + 1
Range("A" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Worksheets("15").Select
Range("d5:cx5004").Select
Selection.Copy
Range("d5").Select
Worksheets("RMIS").Select
x = Range("cv1").Value + 1
Range("A" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Worksheets("16").Select
Range("d5:cx5004").Select
Selection.Copy
Range("d5").Select
Worksheets("RMIS").Select
x = Range("cv1").Value + 1
Range("A" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Worksheets("17").Select
Range("d5:cx5004").Select
Selection.Copy
Range("d5").Select
Worksheets("RMIS").Select
x = Range("cv1").Value + 1
Range("A" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Worksheets("18").Select
Range("d5:cx5004").Select
Selection.Copy
Range("d5").Select
Worksheets("RMIS").Select
x = Range("cv1").Value + 1
Range("A" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Worksheets("19").Select
Range("d5:cx5004").Select
Selection.Copy
Range("d5").Select
Worksheets("RMIS").Select
x = Range("cv1").Value + 1
Range("A" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Worksheets("20").Select
Range("d5:cx5004").Select
Selection.Copy
Range("d5").Select
Worksheets("RMIS").Select
x = Range("cv1").Value + 1
Range("A" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Worksheets("21").Select
Range("d5:cx5004").Select
Selection.Copy
Range("d5").Select
Worksheets("RMIS").Select
x = Range("cv1").Value + 1
Range("A" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Worksheets("22").Select
Range("d5:cx5004").Select
Selection.Copy
Range("d5").Select
Worksheets("RMIS").Select
x = Range("cv1").Value + 1
Range("A" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Worksheets("23").Select
Range("d5:cx5004").Select
Selection.Copy
Range("d5").Select
Worksheets("RMIS").Select
x = Range("cv1").Value + 1
Range("A" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Worksheets("24").Select
Range("d5:cx5004").Select
Selection.Copy
Range("d5").Select
Worksheets("RMIS").Select
x = Range("cv1").Value + 1
Range("A" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Worksheets("25").Select
Range("d5:cx5004").Select
Selection.Copy
Range("d5").Select
Worksheets("RMIS").Select
x = Range("cv1").Value + 1
Range("A" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Worksheets("26").Select
Range("d5:cx5004").Select
Selection.Copy
Range("d5").Select
Worksheets("RMIS").Select
x = Range("cv1").Value + 1
Range("A" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Worksheets("27").Select
Range("d5:cx5004").Select
Selection.Copy
Range("d5").Select
Worksheets("RMIS").Select
x = Range("cv1").Value + 1
Range("A" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Worksheets("28").Select
Range("d5:cx5004").Select
Selection.Copy
Range("d5").Select
Worksheets("RMIS").Select
x = Range("cv1").Value + 1
Range("A" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Worksheets("29").Select
Range("d5:cx5004").Select
Selection.Copy
Range("d5").Select
Worksheets("RMIS").Select
x = Range("cv1").Value + 1
Range("A" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Worksheets("30").Select
Range("d5:cx5004").Select
Selection.Copy
Range("d5").Select
Worksheets("RMIS").Select
x = Range("cv1").Value + 1
Range("A" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Worksheets("31").Select
Range("d5:cx5004").Select
Selection.Copy
Range("d5").Select
Worksheets("RMIS").Select
x = Range("cv1").Value + 1
Range("A" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False




Worksheets("RMIS").Copy
Set DMI = Application.ActiveWorkbook
RIM.Activate
Range("a2").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.EntireRow.Delete
ActiveSheet.Protect Password:="SBIMIS"
DMI.Activate
    Range("CV2").Select
    ActiveCell.FormulaR1C1 = "=IF(R[-1]C[-98]=RC[-98],R[-1]C[-11]-RC[-17],""NEW"")"
    Range("CV2").Select
    Selection.Copy
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("CV1").Select
    Selection.ClearContents
    Range("CW1").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-1],"">0"")+COUNTIF(C[-1],""<0"")"
    MsgBox ("Total Opening closing Mismatch for current month = " & Range("CW1").Value)
    End
End Sub

Display More

Qaiyum · Nov 28th 2013

Hi,

I have bulk data and while copy and pasting data into new workbook using below code, it is creating xls file format and paste function failed. Currently I am working on Excel 2010 version.
Please help how would I assign macro to create new workbook in xlsx format. Thanks in advance.

Code

Workbooks.Add

Qaiyum · Oct 21st 2013

Re: Rename File Name for duplicate

Thanks and I will make ensure rules to be followed and for your great help. The below code which you have provided is showing syntax error Please suggest any modifications required. However other code was useful and successfully run. Thanks....

Code

[U][B]ActiveWorkbook.SaveAs Filename:=Path & "\" & Name & ".xls", FileFormat:=xlExcel8[/B][/U]

Qaiyum · Oct 21st 2013

Re: Rename File Name for duplicate

Code

Private Sub CommandButton1_Click()
    Dim Curr, Mac As Workbook
    Dim wbData, M, Nac As Worksheet
    Dim wsCrit As Worksheet
    Dim wbNew As Worksheet
    Dim RNG As Range
    Dim lastrow As Long
    Dim Cur As Workbook
    Dim QS As Worksheet
    Dim a, b, c, D, Name, PT
    
    Set Text = Application.WorksheetFunction
    
    Set Curr = Application.ActiveWorkbook
    Set M = Application.ActiveSheet
    M.Activate
    Cells.Copy
    Worksheets(Array(M.Name, "E", "Sheet1", "C3R", "MIS", "OSR Report", "VCB", "ERROR", "Remarks")).Copy
      
    Set Mac = Application.ActiveWorkbook
      
    Curr.Activate
        
    Mac.Activate
    Set Nac = Application.ActiveSheet
        PT = Range("a3").Text
        If Range("F3").Text <> 0 Then
        MsgBox ("Limit Over, please contact Concerns immediately")
        Exit Sub
        End If
            
    Nac.Activate
    Set wsCrit = Worksheets.Add
    Nac.Activate
    lastrow = Range("B" & Rows.Count).End(xlUp).Row
    Nac.Range("B4:B3004").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsCrit.Range("A1"), Unique:=True
     
    Set RNG = wsCrit.Range("A2")
    
    Path = PT
    
    While RNG.Value <> ""
        Set wbNew = Worksheets.Add
        Nac.Range("B4:DE" & lastrow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=RNG.Offset(-1).Resize(2), CopyToRange:=wbNew.Range("A1"), Unique:=True
        wbNew.Name = "TP"
        Range("A2:DD202").Select
        Selection.Copy
        Worksheets("E").Select
        Range("A2").Select
        Selection.PasteSpecial Paste:=xlPasteValues
        
        Worksheets(Array("E", "Sheet1", "C3R", "MIS", "OSR Report", "VCB", "ERROR", "Remarks")).Copy
        
        Worksheets("C3R").Select
        Range("A1").Select
        Cells.Copy
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Range("C5").Select
        Name = ActiveCell.Text
                If Range("j8").Value < 0 Then
                MsgBox (Name & " VCB Closing Balance is having Minus figure in 100 denom - Please check after this macro")
                End If
                If Range("j9").Value < 0 Then
                MsgBox (Name & " VCB Closing Balance is having Minus figure in 500 denom - Please check after this macro")
                End If
                If Range("j10").Value < 0 Then
                MsgBox (Name & " VCB Closing Balance is having Minus figure in 1000 denom - Please check after this macro")
                End If
                If Range("j11").Value < 0 Then
                MsgBox (Name & " VCB Closing Balance is having Minus figure - Please check after this macro")
                End If
            If Range("n8").Value <> 0 Then
            MsgBox ("Wrong VCB Uploaded - 100")
            End If
            If Range("n9").Value <> 0 Then
            MsgBox ("Wrong VCB Uploaded - 500")
            End If
            If Range("n10").Value <> 0 Then
            MsgBox ("Wrong VCB Uploaded - 1000")
            End If
                    
        ActiveSheet.Protect Password:="s"
        
        Worksheets("VCB").Select
        Range("A1").Select
        Cells.Copy
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Range("a1").Select
        Selection.ClearContents
        
        Worksheets("REMARKS").Select
        Range("A1").Select
        Cells.Copy
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Range("a1").Select
        
        Worksheets("OSR REPORT").Select
        Range("A1").Select
        Cells.Copy
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Range("a1").Select
        
        Worksheets("ERROR").Select
        Range("A1").Select
        Cells.Copy
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Range("a1").Select
        
        Worksheets("MIS").Select
        Range("A1").Select
        Cells.Copy
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Range("a1").Select
        
        [U][B]ActiveWorkbook.SaveAs Filename:=Path & "\" & Name & ".xls", FileFormat:=xlExcel8[/B][/U]
        Application.DisplayAlerts = False
        Sheets("E").Delete
        Sheets("C3R").Select
        ActiveWorkbook.Save
        ActiveWorkbook.Close False
        wbNew.Delete
        RNG.EntireRow.Delete
        Set RNG = wsCrit.Range("A2")
        Application.DisplayAlerts = True
        
    Wend
End
End Sub

Display More

_____________________________________________________________________________________________

*EDIT*
When you post code in a message you are required to use Code Tags. These format and colourise the code making it easier to read and so follow the logic. This is one of the rules you agreed to when you joined the forum.

The tags have been added for you, but this time only. Please ensure future posts comply with the rules.

Qaiyum · Oct 21st 2013

Hi,

I want to save a excel file into particular folder, if the same name file found macro should automatically save this file also with making a same name and adding "Copy" or "duplicate" at the end.

Eg. Xyz.xls (if same name file found, macro should save this file also with xyz (copy).xls)

Is there any code then please help.

Regards,
Abdul Qaiyum Shaikh

Qaiyum · Aug 22nd 2013

Re: Check Box

Hi,

Actually i want to untick all the checkbox available in userform with the help of command button. Please help.

Qaiyum · Aug 22nd 2013

Hi,
Please help me check box. I have a userform where there are several check box and a command buttons name "clear all". Here i want to unticked all the checkbox when clear all button is clicked by user.
Qaiyum Shaikh