• Ask a Question
150
Insert Image Size must be less than < 5MB.
    Ask a Question
    Cancel
    150
    More answer You can create 5 answer(s).
      Ask a Poll
      Cancel
      Expert

      Need Help with automation.

      Hello all,
      My job involves comparing data every fortnight. I receive the report in a text file. Some members could be omitted and new members could be added. The unique EID in is given to each member.

      I was doing this with MS Access 2003. Recently we had new hardware upgrade and MS Office 2010 was installed without MS Access 2010. Though I can do a lot with MS Access, I am a novice with MS Excel.

      For example,

      Pay day 23MAR17

      EID Surname GivenName  Pay <<< Heading
      14123 Prabhu Raghu $2,721.00
      14124 Jain Sanjay $2,727.00
      14125 O’Connell Greg $2,222.00
      14126 Nitiskas John $3,425.00
      14127 Sawant Bhanu $2,263.00
      14128 Evans Craig $2,440.00
      14129 Sawant Vim $2,721.00
      Pay Day 06APR14

      EID Surname GivenName  Pay <<< Heading
      14123 Prabhu Raghu $2,821.00
      14124 Jain Sanjay $2,727.00
      14125 O’Connell Greg $2,222.00
      14127 Sawant Bhanu $2,263.00
      14128 Evans Craig $2,440.00
      14129 Prabhu Vim $2,721.00
      14130 Kamath Sunil $2,222.00

      14126 Nitiskas John $3,425.00 has dropped out from previous fortnight
      14130 Kamath Sunil $2,222.00 has been added in the current fortnight

      Comparing

      14123 Prabhu Raghu $2,721.00
      14123 Prabhu Raghu $2,821.00 Had a pay rise

      14129 Sawant Vim $2,721.00
      14129 Prabhu Vim $2,721.00 Had a surname change

      I have 5 worksheets in the workbook. They are named “PreviousFN”, “CurrentFN”,”OmittedMembers”, “NewMembers” and “ChangedMembers”
      I need some help with automating this. Any ideas would be welcome.

      Each fortnight there would be 6000+ records.

      100-200 members drop out

      100-200 new members are added

      800-999 members have change.

      I format the data and pass it on to other members for processing.

      Regards

      Raghu

      Asked by raghuprabhu on April 13, 2017 in VBA.
      1 Answers
      Expert

      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

       

       

      Answered by raghuprabhu on August 8, 2017..