Posts by Raha

Raha · Mar 5th 2016

Re: VBA Code: excel is hanging at some point

I have added two extra line in the code and this should work, please try.

Code

Sub Test()
    Dim Rng As Range, A As Variant, e As Variant, sht As Worksheet, n As Long, i As Long
    
    On Error Resume Next
    Set sht = ThisWorkbook.Sheets("Dispatch_load")
    If sht Is Nothing Then
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Dispatch_load"
    End If
    
    n = 10: i = 0
    With Sheets("AMC Agent Breakout")
        .Activate
        For Each e In Array("KAX0", "KAX1", "KAX2", "KAX3", "KAX4", "KAX5", "KAX6", "KAX7", "KAX8", "KAX9")
            .Range("A1:R" & .Range("A" & .Rows.Count).End(xlUp).Row).AutoFilter Field:=8, Criteria1:=e
            .Range("A1:R" & .Range("A" & .Rows.Count).End(xlUp).Row).AutoFilter Field:=18, Criteria1:="0"
            Set Rng = .AutoFilter.Range.Offset(1, 0).Resize(.AutoFilter.Range.Rows.Count - 1, .AutoFilter.Range.Columns.Count) _
            .SpecialCells(xlCellTypeVisible)
            
            If Not Rng Is Nothing Then
                On Error Resume Next
                Set sht = ThisWorkbook.Sheets("Agent&DRM")
                If sht Is Nothing Then
                    Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Agent&DRM"
                End If
                With Sheets("Agent&DRM")
                    .Activate
                    .UsedRange.Clear
                    ' Added to clear the existing data
                    Rng.Copy .Range("C6")
                    .Columns("C:I").Delete Shift:=xlToLeft
                    .Columns("D:J").Delete Shift:=xlToLeft
                    .Columns("E:F").Delete Shift:=xlToLeft
                    .Range("T17").FormulaR1C1 = "AAX" & i
                    .Range("U17").FormulaR1C1 = "=SUM(R[-11]C[-17]:R[8983]C[-17])"
                    .Range("T17:U17").Copy
                    Sheets("Dispatch_load").Range("A" & n).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                End With
            n = n + 1: i = i + 1
            End If
            .AutoFilterMode = False
            Set Rng = Nothing
            ' Newly added to release the memory
        Next
    End With
End Sub

Display More

Raha · Mar 5th 2016

Re: Trying to put first name from full name using VBA

Try the below codes and adopt as per your convenience.
While using udf please note 0=first name,1=sencond name......so on.

Code

Option Explicit




Function Findnames(names As String, n As String)
    Dim Omatch As Object, i As Long
    With CreateObject("VBscript.regexp")
        .Global = True
        .Pattern = "([^ ]+)"
        If .Test([a1]) Then
            Set Omatch = .Execute([a1])
            For i = 0 To Omatch.Count - 1
                If i = n Then
                    Findnames = Omatch(i)
                    Exit For
                End If
            Next
        End If
    End With
End Function




Sub Findnames1()
    With CreateObject("VBscript.regexp")
        .Global = True: .Pattern = "([^ ]+)"
        MsgBox .Execute([a1])(0)
        MsgBox .Execute([a1])(2)
    End With
End Sub


Sub Findname2()
    MsgBox Split([a1], " ")(0)
    MsgBox Split([a1], " ")(2)
End Sub

Display More

Raha · Mar 3rd 2016

Re: VBA Code: excel is hanging at some point

Both the way you can complete your task, please try.

Code

Option Explicit




Sub Test()
    Dim Rng As Range, A As Variant, e As Variant, sht As Worksheet, n As Long, i As Long
    
    On Error Resume Next
    Set sht = ThisWorkbook.Sheets("Dispatch_load")
    If sht Is Nothing Then
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Dispatch_load"
    End If
    
    n = 10: i = 0
    With Sheets("AMC Agent Breakout")
        .Activate
        For Each e In Array("KAX0", "KAX1", "KAX2", "KAX3", "KAX4", "KAX5", "KAX6", "KAX7", "KAX8", "KAX9")
            .Range("A1:R" & .Range("A" & .Rows.Count).End(xlUp).Row).AutoFilter Field:=8, Criteria1:=e
            .Range("A1:R" & .Range("A" & .Rows.Count).End(xlUp).Row).AutoFilter Field:=18, Criteria1:="0"
            Set Rng = .AutoFilter.Range.Offset(1, 0).Resize(.AutoFilter.Range.Rows.Count - 1, .AutoFilter.Range.Columns.Count) _
            .SpecialCells(xlCellTypeVisible)
            
            If Not Rng Is Nothing Then
                On Error Resume Next
                Set sht = ThisWorkbook.Sheets("Agent&DRM")
                If sht Is Nothing Then
                    Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Agent&DRM"
                End If
                With Sheets("Agent&DRM")
                    .Activate
                    Rng.Copy .Range("C6")
                    .Columns("C:I").Delete Shift:=xlToLeft
                    .Columns("D:J").Delete Shift:=xlToLeft
                    .Columns("E:F").Delete Shift:=xlToLeft
                    .Range("T17").FormulaR1C1 = "AAX" & i
                    .Range("U17").FormulaR1C1 = "=SUM(R[-11]C[-17]:R[8983]C[-17])"
                    .Range("T17:U17").Copy
                    Sheets("Dispatch_load").Range("A" & n).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                End With
            End If
            n = n + 1: i = i + 1
            .AutoFilterMode = False
        Next
    End With
End Sub




Sub Test1()
    Dim Rng As Range, Rng1 As Range, rng2 As Range
    Dim sht As Worksheet
    
    On Error Resume Next
    Set sht = ThisWorkbook.Sheets("Dispatch_load")
    If sht Is Nothing Then
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Dispatch_load"
    End If
    
    With Sheets("AMC Agent Breakout")
        .Range("A1:R" & .UsedRange.Rows.Count).AutoFilter Field:=8, Criteria1:="=KAX*"
        .Range("A1:R" & .UsedRange.Rows.Count).AutoFilter Field:=18, Criteria1:="=0"
        On Error Resume Next
        Set Rng = .AutoFilter.Range.Offset(1, 7).Resize(.AutoFilter.Range.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
        Set Rng1 = .AutoFilter.Range.Offset(1, 15).Resize(.AutoFilter.Range.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
        Set rng2 = Union(Rng, Rng1)
        
        If Not rng2 Is Nothing Then
            rng2.Copy Sheets("Dispatch_load").Range("A10")
        End If
        .AutoFilterMode = False
    End With
End Sub

Display More

Raha · Feb 6th 2016

Re: IE Date picker and Mouse over/mouse hover

HI Team,

Please advise if there is any solution for my query?

Code

</div>
                </div>
                <div class="date_wrapper">
                    <p>
                        <input type="text" id="datePicker" onchange="GetData()" onfocus="this.blur()" readonly="true" class="datePickerassociate" />
                    </p>
                </div>
                <div style="width: 100%; height: 20px;"></div>
                <div class="clearFloat"></div>

Thanks in advance for all your help and support.

Regards,
Rahaman

Raha · Feb 4th 2016

Hi Team,

Could you please help me in selecting the date from IE date picker & FireEvent ("onchange") as i am successfully able to input the date into text box but page not getting refreshed and also want to loop though the mouse over text and print to excel sheet.

I have attached the page source code and screen shots as well as some of my workout for your reference.

Kindly advise.

Thanks in advance for the help.

Regards,
Rahaman.

Raha · Jan 7th 2016

Re: Regex submatches (Regular expression)

Hi SO,

Below is my final workout which works extremely good without any obstacle.

Code

Option Explicit
Sub Test()
    Dim i As Long
    Dim ii As Long
    Dim iii As Long, L As Long
    Dim A As Variant, x As Variant
    Dim omatch As Object
    Dim n As Long, e As Variant
    Dim myarray() As Variant
    With Sheets(1).UsedRange
        A = .Value
        .ClearContents
        With CreateObject("vbscript.regexp")
            .MultiLine = True
            .Ignorecase = True
            .Global = True
            For i = 1 To UBound(A, 1)
                .Pattern = "Customer Name:(.*)?customer number:(.*)?"
                If .Test(A(i, 1)) Then
                    n = n + 1
                    ReDim Preserve myarray(1 To 11, 1 To n)
                    Set omatch = .Execute(A(i, 1))(0)
                    For Each e In omatch.submatches
                        L = L + 1: myarray(L, n) = Trim$(e)
                    Next
                End If
                .Pattern = "^(\d+-\D+-\d+) *(RES asfdfsda \d+)(.*)(RES CHECK \d+)(.*)( \d+-\D+-\d+)"
                If .Test(A(i, 1)) Then
                    Set omatch = .Execute(A(i, 1))(0)
                    For Each e In omatch.submatches
                        L = L + 1: myarray(L, n) = Trim$(e)
                    Next
                    .Pattern = "(\d+[,.]+(\d+\.)?\d+)"
                    If .Test(A(i, 1)) Then
                        Set omatch = .Execute(A(i, 1))
                        For Each e In omatch
                            L = L + 1: myarray(L, n) = Trim$(e)
                        Next
                    End If
                End If
            Next
        End With
        
        With .Range("A12").Resize(UBound(myarray, 2), UBound(myarray, 1))
            .CurrentRegion.Borders.LineStyle = xlNone
            .ClearContents
            .Value = Application.Transpose(myarray)
            .Cells(1).Offset(, 8).Resize(, 3).NumberFormat = "#,##0.00"
            .CurrentRegion.Borders.Weight = 2
        End With
    End With
End Sub

Display More

Raha · Jan 6th 2016

Re: Regex submatches (Regular expression)

Hi SO,

Please have a look on the attached workbook and coding,

I am pretty sure the way i used might be wrong but it working fine.

any improvement and suggestions are most welcome as i am trying to learn this regex(regular expression).

Thank you.

Regards.
Rahaman

Raha · Jan 6th 2016

Re: Regex submatches (Regular expression)

Hi kjbox,

Thanks for the solution/coding, it works fine.

Hi SO,

I managed to do with regex submatches and it working fine and cross checked with multiple files as well but i don't know the way i used is right or wrong.

Will post my workout/coding tomorrow as it already 2.45 Am

Thank you for all your help and support.

Have a great day.

regards,
Rahaman

Raha · Jan 5th 2016

Hi Team,

Could you please advise how to achieve the below result using regex(Regular expression)
and spaces may not be constant always.

Raw data
Customer Name: Naseer Rahaman CUSTOMER NUMBER: 2010-1234567
22-DEC-15 RES asfdfsda 84723 15285282 RES CHECK 0 123456 23-DEC-15 5,219.55 0.00 0.00

Expected Result

Naseer Rahaman 2010-1234567 22-Dec-15 RES asfdfsda 84723 15285282 RES CHECK 0 123456 23-Dec-15 5,219.55 0.00 0.00

Please find the attached workbook for your reference and advise.

Thanks in advance for all your help and support.

Regards,
Rahaman

[TABLE="width: 156"]

[tr]

[td][/td]

[/tr]

[/TABLE]

Raha · Nov 18th 2015

Re: Regular expression (regexp) to validate only amounts in a row

Hi So,

Code is working fine.

thank you for the help.

Regards,
Rahaman.

Raha · Nov 18th 2015

Re: Regular expression (regexp) to validate only amounts in a row

Hi nilem,

Both the codes are working fine.

Thank you for all your help.

Regards,
Rahaman.

Raha · Nov 18th 2015

Hi Team,

Could you please help me to build a regex pattern to validate the amounts by exluding extra comma and dots.

Eg: sdafasdf $1,000.00…….. Ljlkjlkj $1,000,00,,,,,,,,,……………… asdfasdf $2,000,00,,,...,,,

from the above line i am trying to pick only the amounts i.e. $1,000.00 $1,000,00 and $2,000,00

Kindly advise.

Thanks in advance for the help.

Regards,
Rahaman.

Raha · Oct 20th 2015

Re: Application-defined or object-defined error

Hi Jindon,

I Apologies for my previous post.

Will use your coding....

Thank you for all your help and support.

Regards,
Rahaman

Quote from jindon;758623

That code you are referring to in you first post is useless when you have many rows and the code I posted here is much faster.

Raha · Oct 20th 2015

Re: Application-defined or object-defined error

Hi Jindon,

Thank you for your quick reply,

Actually i am trying to avoid the loops and
for learning purpose please advise is there any problem with my code or is there any limitation for index method.
because if i update the columns count manually it is working for huge data as well.

Kindly advise.

Thank you for all your help and support.

Regards,
Rahaman

Raha · Oct 19th 2015

Hi Team,

the below code in the application.index line getting error message as "Run time error 1004: Application-defined or object-defined error" but its working fine upto 1000 rows.

Original jindon code is in the below link which i am trying to adopt.
"http://www.ozgrid.com/forum/showthread.php?t=196868&p=756887%23post756887"

Code

Sub Test()    Dim x
    With Cells(1).CurrentRegion.Offset(1)
        .Columns(3).ClearContents
        x = Filter(Evaluate("Transpose(if(isnumber(match(" _
        & .Columns(1).Address & "," & .Columns(2).Address & ",0))," & _
        "Row(1:" & .Rows.Count & ")" & ",char(2)))"), Chr(2), 0)
        If UBound(x) > -1 Then
            x = Application.Index(.Value, Application.Transpose(x), Evaluate("Column(1:" & .Columns.Count & ")"))
            .Columns(3).Resize(UBound(x, 1), .Columns.Count).Value = x
        End If
    End With
End Sub

Display More

I hereby request your good selves to kindly advise on the issue.

Thanks in advance for the help.

Regards,
Rahaman

Raha · Oct 7th 2015

Re: picture/shapes/screen shots formatting in word document with word vba

Hi Team,

Could you please help me on the above request.

Thanks in advance for the help.

Regards,
Rahaman.

Raha · Oct 1st 2015

Hi Team,

Could you please advise how to format the picture/shapes/screen shots in word document using word vba as macro recording not allowing to record the picture formatting.

For eg: Size Heigt:3
Width=6
Rotation=0
Scale height=100
Scale width=100
Lock aspect ratio=deselect/un-check/false
Relative to Original picture size=deselect/un-check/false
line color=solid line with black color

and attached the word template with the screen shot for your reference.

Kindly advise.

Thanks in advance for the help.

Regards,
Rahaman.

Raha · May 19th 2015

Re: printing keys and items directly from child/sub dictionary to worksheet

Quote from jindon;746278

Simply no way.

Thank you for guiding me Jindon.

Have a nice day.

Raha · May 18th 2015

Hi Team,

Could you please advise how to print the keys and items directly from child/sub dictionary to worksheet without any loop.

please find attached herewith the sample file wherein i am trying to comparing two columns using main dictionary and child/sub dictionary.

Code

Sub Testing()    Dim w, a, b, c, d, e, s, i As Long, ii As Long, R As Range
    Dim keyys(1 To 10, 1 To 10), itemss(1 To 10, 1 To 10)
    a = Range("A1").CurrentRegion.Value
    
    With CreateObject("Scripting.dictionary")
    For i = 1 To UBound(a, 1)
        If Not .exists(a(i, 1)) Then
            Set .Item(a(i, 1)) = CreateObject("scripting.dictionary")
        End If
        If Not .Item(a(i, 1)).exists(a(i, 2)) Then
            .Item(a(i, 1))(a(i, 2)) = VBA.Array(a(i, 1) + 10, a(i, 2) + 20)
        End If
    Next
    
    For i = 0 To .Count - 1 ' trying to print the keys and items without any loop.
        keyys(i + 1, 1) = .keys()(i)
        keyys(i + 1, 2) = .items()(i).keys()(0)
        itemss(i + 1, 1) = .items()(i).items()(0)(0)
        itemss(i + 1, 2) = .items()(i).items()(0)(1)
    Next
    
    Range("D1").Resize(.Count, UBound(a, 2)).Value = keyys
    Range("F1").Resize(.Count, UBound(a, 2)).Value = itemss
    End With
End Sub

Display More

Please advise.

Thanks in advance for all your help and support.

Regards,
Rahaman.

Raha · Sep 3rd 2014

Re: Loop throuugh the Files in share point

Hi Sir,

Excellent, I tried and its working.

Thank you very much for your help.

Regards,
Rahaman