raghuprabhu's Profile
Top Contributor
776
Points

Questions
12

Answers
11

  • Top Contributor Asked on September 7, 2017 in Excel.

    Hi I sorted it out…

     

    Sub LoopThroughDirectory()
    
    Dim MyFile As String
    
    Dim eRow As Long
    
    Dim fRowTBC As Long
    
    Dim LastRow As Long
    
    Dim i As Long
    Dim FilePath As String
    
    FilePath = ActiveWorkbook.Path & "\"
    
    MyFile = Dir(FilePath)
    
    Do While Len(MyFile) > 0
    
    If MyFile = "zmaster.xlsm" Then
    
    Exit Sub
    
    End If
    Workbooks.Open (FilePath & MyFile)
    
    eRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    
    fRowTBC = Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Row
    
    Debug.Print eRow
    
    Debug.Print fRowTBC
    
    For i = 2 To eRow
    
    If Range("E" & i).Value = "" Then
    
    Range("A" & fRowTBC & " : " & "D" & eRow).Copy
    
    End If
    
    Next
    
    ActiveWorkbook.Close
    eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    
    ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(eRow, 1), Cells(eRow, 4))
    If MyFile = "zmaster.xlsm" Then
    
    Exit Sub
    
    End If
    Workbooks.Open (FilePath & MyFile)
    
    eRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    
    fRowTBC = Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Row
    
    Debug.Print eRow
    
    Debug.Print fRowTBC
    
    For i = 2 To eRow - 1
    
    If Range("E" & i).Value = "" Then
    
    Range("E" & i).Value = Date
    
    Columns("E:E").NumberFormat = "[$-C09]dd-mmm-yy;@"
    
    End If
    
    Next
    
    Range("A1").Select
    
    ActiveWorkbook.Save
    
    ActiveWorkbook.Close
    MyFile = Dir
    
    ActiveWorkbook.Save
    
    Loop
    
    End Sub
    

     

    Thanks.

    • 56 views
    • 2 answers
    • 0 votes
    • 82 views
    • 4 answers
    • 0 votes
  • Top Contributor Asked on August 11, 2017 in Excel: General.

    Thanks vaali…

     

    this is the data

     

    sheet1 data

    EID NAME PAY PayDay
    14123 Joe1 $1,234.00 29-Jun-17
    14124 Joe2 $1,235.00 29-Jun-17
    14125 Joe3 $1,236.00 29-Jun-17
    14126 Joe4 $1,237.00 29-Jun-17
    14127 Joe5 $1,238.00 29-Jun-17
    14128 Joe6 $1,239.00 29-Jun-17
    14129 Joe7 $1,240.00 29-Jun-17
    14130 Joe8 $1,241.00 29-Jun-17
    14131 Joe9 $1,242.00 29-Jun-17
    14132 Joe10 $1,243.00 29-Jun-17
    14133 Joe11 $1,244.00 29-Jun-17
    14134 Joe12 $1,245.00 29-Jun-17
    14135 Joe13 $1,246.00 29-Jun-17
    sheet2 data
    EID NAME PAY PayDay
    14123
    14124
    14125
    14127
    14128
    14129
    14130
    14131
    14134
    14135
    14136
    14137
    14138
    14139
    14140

     

    If you could make it work.

     

    Thanks

    • 82 views
    • 4 answers
    • 0 votes
  • Top Contributor Asked on August 8, 2017 in VBA.

    I have sorted the above problem. Code is given below…

    Sub seperate()
    
    Call CleanSheets
    
    MsgBox "1 of 10 Cleaning sheets done!"
    
    Call CreateHeadings
    
    MsgBox "2 of 10 Create Headings done!"
    
    Call DumpDeleted
    
    MsgBox "3 of 10 Dumped deleted members done!"
    
    Call DumpAdded
    
    MsgBox "4 of 10 Dumped new members done!"
    
    Call DumpCommonFromPrevious
    
    MsgBox "5 of 10 Dumped common from previous members done!"
    
    Call DumpCommonFromCurrent
    
    MsgBox "6 of 10 Dumped common from current members done!"
    
    Call SortMatched
    
    MsgBox "7 of 10 Sorting done!"
    
    Call InsertBlankRows
    
    MsgBox "8 of 10 insert blank rows done!"
    
    Call prepareToDelete
    
    MsgBox "9 of 10 Comparing lines done!"
    
    Call DeleteRows
    
    MsgBox "10 of 10 Deleting common rows done!"
    
    Range("A1").Select
    
    ActiveWorkbook.Save
    
    End Sub
    
    Sub CleanSheets()
    
    Sheets("Deleted").Select
    
    Cells.Select
    
    Selection.Delete Shift:=xlUp
    
    Range("A1").Select
    Sheets("Added").Select
    
    Cells.Select
    
    Selection.Delete Shift:=xlUp
    
    Range("A1").Select
    Sheets("Matched").Select
    
    Cells.Select
    
    Selection.Delete Shift:=xlUp
    
    Range("A1").Select
    
    End Sub
    Sub CreateHeadings()
    
    Sheets("Deleted").Select
    
    ActiveCell.FormulaR1C1 = "EID"
    
    Range("B1").Select
    
    ActiveCell.FormulaR1C1 = "NAME"
    
    Range("C1").Select
    
    ActiveCell.FormulaR1C1 = "PAY"
    
    Range("D1").Select
    
    ActiveCell.FormulaR1C1 = "PayDay"
    
    Range("A1:D1").Select
    
    Selection.Font.Bold = True
    
    Selection.Font.Underline = xlUnderlineStyleSingle
    
    With Selection
    
    .HorizontalAlignment = xlCenter
    
    .VerticalAlignment = xlBottom
    
    .WrapText = False
    
    .Orientation = 0
    
    .AddIndent = False
    
    .IndentLevel = 0
    
    .ShrinkToFit = False
    
    .ReadingOrder = xlContext
    
    .MergeCells = False
    
    End With
    
    Range("A1").Select
    Sheets("Added").Select
    
    ActiveCell.FormulaR1C1 = "EID"
    
    Range("B1").Select
    
    ActiveCell.FormulaR1C1 = "NAME"
    
    Range("C1").Select
    
    ActiveCell.FormulaR1C1 = "PAY"
    
    Range("D1").Select
    
    ActiveCell.FormulaR1C1 = "PayDay"
    
    Range("A1:D1").Select
    
    Selection.Font.Bold = True
    
    Selection.Font.Underline = xlUnderlineStyleSingle
    
    With Selection
    
    .HorizontalAlignment = xlCenter
    
    .VerticalAlignment = xlBottom
    
    .WrapText = False
    
    .Orientation = 0
    
    .AddIndent = False
    
    .IndentLevel = 0
    
    .ShrinkToFit = False
    
    .ReadingOrder = xlContext
    
    .MergeCells = False
    
    End With
    
    Range("A1").Select
    Sheets("Matched").Select
    
    ActiveCell.FormulaR1C1 = "EID"
    
    Range("B1").Select
    
    ActiveCell.FormulaR1C1 = "NAME"
    
    Range("C1").Select
    
    ActiveCell.FormulaR1C1 = "PAY"
    
    Range("D1").Select
    
    ActiveCell.FormulaR1C1 = "PayDay"
    
    Range("E1").Select
    
    ActiveCell.FormulaR1C1 = "Product"
    
    Range("A1:E1").Select
    
    Selection.Font.Bold = True
    
    Selection.Font.Underline = xlUnderlineStyleSingle
    
    With Selection
    
    .HorizontalAlignment = xlCenter
    
    .VerticalAlignment = xlBottom
    
    .WrapText = False
    
    .Orientation = 0
    
    .AddIndent = False
    
    .IndentLevel = 0
    
    .ShrinkToFit = False
    
    .ReadingOrder = xlContext
    
    .MergeCells = False
    
    End With
    
    Range("A1").Select
    End Sub
    
    Sub DumpDeleted()
    
    Sheets("Previous").Select
    
    Range("A2").Select
    
    Do While ActiveCell.Value <> ""
    
    If Application.WorksheetFunction.CountIf(Sheets("Current").Range("A:A"), ActiveCell.Value) = 0 Then
    
    Range(ActiveCell.Row & ":" & ActiveCell.Row).Copy Sheets("Deleted").Range("A10000").End(xlUp).Offset(1, 0)
    
    End If
    
    ActiveCell.Offset(1, 0).Select
    
    Loop
    
    Sheets("Deleted").Select
    
    Columns("A:D").Select
    
    Selection.Columns.AutoFit
    
    Range("A1").Select
    
    End Sub
    Sub DumpAdded()
    
    Sheets("Current").Select
    
    Range("A2").Select
    
    Do While ActiveCell.Value <> ""
    
    If Application.WorksheetFunction.CountIf(Sheets("Previous").Range("A:A"), ActiveCell.Value) = 0 Then
    
    Range(ActiveCell.Row & ":" & ActiveCell.Row).Copy Sheets("Added").Range("A10000").End(xlUp).Offset(1, 0)
    
    End If
    
    ActiveCell.Offset(1, 0).Select
    
    Loop
    
    Sheets("Added").Select
    
    Columns("A:D").Select
    
    Selection.Columns.AutoFit
    
    Range("A1").Select
    
    End Sub
    Sub DumpCommonFromPrevious()
    
    Sheets("Previous").Select
    
    Range("A2").Select
    
    Do While ActiveCell.Value <> ""
    
    If Application.WorksheetFunction.CountIf(Sheets("Current").Range("A:A"), ActiveCell.Value) <> 0 Then
    
    Range(ActiveCell.Row & ":" & ActiveCell.Row).Copy Sheets("Matched").Range("A10000").End(xlUp).Offset(1, 0)
    
    End If
    
    ActiveCell.Offset(1, 0).Select
    
    Loop
    
    Sheets("Matched").Select
    
    Columns("A:D").Select
    
    Selection.Columns.AutoFit
    
    Range("A1").Select
    
    End Sub
    Sub DumpCommonFromCurrent()
    
    Sheets("Current").Select
    
    Range("A2").Select
    
    Do While ActiveCell.Value <> ""
    
    If Application.WorksheetFunction.CountIf(Sheets("Previous").Range("A:A"), ActiveCell.Value) <> 0 Then
    
    Range(ActiveCell.Row & ":" & ActiveCell.Row).Copy Sheets("Matched").Range("A10000").End(xlUp).Offset(1, 0)
    
    End If
    
    ActiveCell.Offset(1, 0).Select
    
    Loop
    
    Sheets("Matched").Select
    
    Columns("A:D").Select
    
    Selection.Columns.AutoFit
    
    Range("A1").Select
    
    End Sub
    Sub SortMatched()
    
    Dim lRow As Long
    
    lRow = Cells(Rows.Count, 1).End(xlUp).Row
    Sheets("Matched").Select
    
    Cells.Select
    
    ActiveWorkbook.Worksheets("Matched").Sort.SortFields.Clear
    
    ActiveWorkbook.Worksheets("Matched").Sort.SortFields.Add Key:=Range("A2:A" & lRow) _
    
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
    ActiveWorkbook.Worksheets("Matched").Sort.SortFields.Add Key:=Range("D2:D" & lRow) _
    
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
    With ActiveWorkbook.Worksheets("Matched").Sort
    
    .SetRange Range("A1:E" & lRow)
    
    .Header = xlYes
    
    .MatchCase = False
    
    .Orientation = xlTopToBottom
    
    .SortMethod = xlPinYin
    
    .Apply
    
    End With
    
    Columns("A:E").Select
    
    Selection.Columns.AutoFit
    
    Range("A1").Select
    
    End Sub
    Sub InsertBlankRows()
    
    Dim intStartRow As Integer
    
    Dim intLastRow As Integer
    
    Dim iCntr As Integer
    intStartRow = 4 'Since the Row 1 have headers
    
    intLastRow = Sheets("Matched").Cells(Sheets("Matched").Rows.Count, "A").End(xlUp).Row - 1
    
    For iCntr = intLastRow To intStartRow Step -2
    
    Rows(iCntr).EntireRow.Insert
    
    Next
    
    End Sub
    Sub prepareToDelete()
    
    Dim intStartRow As Integer
    
    Dim intLastRow As Integer
    
    Dim iCntr As Integer
    intStartRow = 4 'Since the Row 1 have headers
    
    intLastRow = Sheets("Matched").Cells(Sheets("Matched").Rows.Count, "A").End(xlUp).Row + 1
    For iCntr = intLastRow To intStartRow Step -3
    
    Range("B" & iCntr).Select
    
    ActiveCell.FormulaR1C1 = "=R[-1]C=R[-2]C"
    
    Range("B" & iCntr).Select
    
    ActiveCell.FormulaR1C1 = "=(R[-1]C=R[-2]C)*1"
    
    Range("B" & iCntr).Select
    
    Selection.AutoFill Destination:=Range("B" & iCntr & ":" & "C" & iCntr), Type:=xlFillCopy
    
    Range("B" & iCntr & ":" & "C" & iCntr).Select
    
    Range("E" & iCntr).Select
    
    ActiveCell.FormulaR1C1 = "=PRODUCT(RC[-3]:RC[-2])"
    
    Next
    
    End Sub
    Sub DeleteRows()
    
    Dim i As Integer
    
    Dim FirstRow As Integer
    
    Dim LastRow As Integer
    
    FirstRow = 2
    
    Sheets("Matched").Select
    
    LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
    
    For i = LastRow To FirstRow Step -1
    
    If Cells(i, 5) = 0 Then
    
    Rows(i).Delete Shift:=xlUp
    
    ElseIf Cells(i, 5) = 1 Then
    
    Rows(i - 2 & ":" & i).Delete Shift:=xlUp
    
    End If
    
    i = i - 2
    
    Next i
    Columns("E:E").Select
    
    Selection.Delete Shift:=xlToLeft
    
    Range("A1").Select
    End Sub
    Function GetLastRow() As Integer
    
    Dim i As Integer
    
    Range("A1").Select
    
    i = 1
    
    Do
    
    Selection.Offset(1, 0).Select
    
    i = i + 1
    
    If Selection.Value = "" Then
    
    GetLastRow = i
    
    End If
    
    Loop
    End Function
    

    The workbook has 5 worksheets named “Previous”, “Current”, “Deleted”,”Added” and “Matched”

     

    The data in “Previous” is

    EID NAME PAY PayDay
    14123 Joe1 $1,234.00 29-Jun-17
    14124 Joe2 $1,235.00 29-Jun-17
    14125 Joe3 $1,236.00 29-Jun-17
    14126 Joe4 $1,237.00 29-Jun-17
    14127 Joe5 $1,238.00 29-Jun-17
    14128 Joe6 $1,239.00 29-Jun-17
    14129 Joe7 $1,240.00 29-Jun-17
    14130 Joe8 $1,241.00 29-Jun-17
    14131 Joe9 $1,242.00 29-Jun-17
    14132 Joe10 $1,243.00 29-Jun-17
    14133 Joe11 $1,244.00 29-Jun-17
    14134 Joe12 $1,245.00 29-Jun-17
    14135 Joe13 $1,246.00 29-Jun-17

    and in “Current” is

    EID NAME PAY PayDay
    14123 Joe11 $1,234.00 13-Jul-17
    14124 Joe2 $1,222.00 13-Jul-17
    14125 Joe3 $1,236.00 13-Jul-17
    14127 Joe5 $3,333.00 13-Jul-17
    14128 Joe66 $1,239.00 13-Jul-17
    14129 Joe7 $4,444.00 13-Jul-17
    14130 Joe8 $1,241.00 13-Jul-17
    14131 Joe99 $5,555.00 13-Jul-17
    14134 Joe12 $1,245.00 13-Jul-17
    14135 Joe13 $6,666.00 13-Jul-17
    14136 Joe14 $1,247.00 13-Jul-17
    14137 Joe15 $7,777.00 13-Jul-17
    14138 Joe16 $1,249.00 13-Jul-17
    14139 Joe17 $8,888.00 13-Jul-17
    14140 Joe18 $1,251.00 13-Jul-17

     

    Please feel free to modify the code….

     

    Regards

     

    Raghu

     

     

    • 103 views
    • 1 answers
    • 0 votes
    • 60 views
    • 4 answers
    • 0 votes
  • Top Contributor Asked on May 13, 2017 in Excel.

     

    Sub ConcatenateSurnameAndInitials()
    'Concatenates initials from given names (column 2) to proper surname in column 3
     Dim a, j As Long
     With Cells(1).CurrentRegion.Resize(, 3)
     a = .Value
     For j = 1 To UBound(a, 1)
     a(j, 3) = Trim$(StrConv(a(j, 1), 3)) & IIf(a(j, 2) <> "", ", ", "") & GetInitial(a(j, 2))
     Next
     .Value = a
     End With
     End Sub
     ials from given names (column 2) to proper surname in column 3
     Dim a, j As Long
     With Cells(1).CurrentRegion.Resize(, 3)
     a = .Value
     For j = 1 To UBound(a, 1)
     a(j, 3) = Trim$(StrConv(a(j, 1), 3)) & IIf(a(j, 2) <> "", ", ", "") & GetInitial(a(j, 2))
     Next
     .Value = a
     End With
     End Sub
    

     

    Function GetInitial(ByVal txt As String) As String
     Dim m
     With CreateObject("VBScript.RegExp")
     .Global = True: .IgnoreCase = True
     .Pattern = "\b[A-Z]"
     For Each m In .Execute(txt)
     GetInitial = GetInitial & m
     Next
     End With
     End Function
    
    • 81 views
    • 3 answers
    • 0 votes
  • Top Contributor Asked on May 13, 2017 in Excel.

    Thank sorted out…

    • 81 views
    • 3 answers
    • 0 votes
  • Top Contributor Asked on April 24, 2017 in Excel.

    I don’t know if this is right … the column “Product” is in worksheet “MbrsDetChanged”

    comes up with an error

    Runtime error 1004

    Method range of object _Global fail

    Sub DeleteRows()
     Sheets("MbrsDetChanged").Select
     For i = LastRow To firstrow Step -1
     If Range(i, "Product") = 0 Then
     Rows(i).Delete shift:=xlUp
     ElseIf Range(i, "Product") = 1 Then
     Rows(i - 2 & ":" & i).Delete shift:=xlUp
     End If
     Next i
    End Sub
    

    Regards
    Raghu

    • 87 views
    • 2 answers
    • 0 votes
  • Top Contributor Asked on April 23, 2017 in VBA.

    Now I have added two more worksheets called “Omitted” and “Changed”.

     

    How do I change the above code? So that, if EMPIds are macthing copy them  “Changed”.   And if EMPIds are NOT macthing copy them to “Omitted” please?

     

    Thanks.

    • 97 views
    • 3 answers
    • 0 votes
  • Top Contributor Asked on April 13, 2017 in VBA.

    PNRao Garu,

    Thank you for your response…

    I modified it as follows and it is working and doing what I want…

    Sub VBAF1_InsertBlankRows()
    intStartRow = 2 'Since the Row 1 have headers
    intLastRow = Sheets("Matched").Cells(Sheets("Matched").Rows.Count, "A").End(xlUp).Row - 1
    For iCntr = intLastRow To intStartRow Step -2
    Rows(iCntr).EntireRow.Insert
    Next
    End Sub
    

    Regards

     

    • 85 views
    • 2 answers
    • 0 votes
  • Top Contributor Asked on April 9, 2017 in VBA.

    Thanks a lot …fantastic!

     

    • 97 views
    • 3 answers
    • 0 votes