Categorised Menu List

Context:

  • You got your data from any of the data servers or ERPs like SAP, Lawson, JD Edwards or some other software etc.

  • The work involves, to copy only that data that is required, into a new sheet (leaving the summaries, and other unnecessary data behind., we need only data and not summary)

  • Generally, we get data in CSV file format (Comma Seperated Values), which can be opened in Excel.

Explanation:

  • Split the data with "Text to Columns" option form Data Menu
  • Input new data values into a separate column (Col R in the given example)
  • Classify the data into required and not required.
  • for example: mark required rows are marked as "CP", meaning Copy, "VE" as Vendor, "CC" as Company Code, not required data as "Unknown" and the like (as per your convenience)
  • Copy all the required data into a separate sheet, leaving all the Unknown marked rows in the same sheet.

Code Used:

SEGREGATING RAW DATA 

IN CURRENT WORK SHEET

Code ReUse - Gives you more time
to think different

Sample Data:

gallery/rawdata

Dim strVendor As String, strCCode As String, strName As String, strCity As String
Dim strCRow As String, strCCol As String, strMCRow As String
Dim blTitles As Boolean

 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Sub prcCode2()
Dim i As Long
Dim dtStart As String, dtEnd As String

Application.ScreenUpdating = False
Worksheets("Main").Select
Range("A:AZ").Clear
If blTitles = False Then prcPasteHeaders

Worksheets("0110").Select
Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select

strCRow = ActiveCell.Row
strCCol = ActiveCell.Column

'prcMarkEntries
prcPasteData

Application.ScreenUpdating = True
End Sub

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

 

Sub prcMarkEntries()
Dim i As Long
Range("X1").Select
For i = 1 To strCRow
    If UCase(Trim(Range("A" & i))) = "VENDOR" Then
        Range("X" & i) = "VE"
    ElseIf UCase(Trim(Range("A" & i))) = "COMPANY CODE" Then
        Range("X" & i) = "CC"
    ElseIf UCase(Trim(Range("A" & i))) = "NAME" Then
        Range("X" & i) = "NM"
    ElseIf UCase(Trim(Range("A" & i))) = "CITY" Then
        Range("X" & i) = "CT"
    ElseIf UCase(Trim(Range("C" & i))) = "ASSIGNMENT" Then
        Range("X" & i) = "AS"
    ElseIf WorksheetFunction.IsNumber((Range("D" & i).Value)) Then
        Range("X" & i) = "CP"
    Else
        Range("X" & i) = "Unknown"
    End If
    Application.StatusBar = "Working on Row: " & i
Next

End Sub

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

 

Sub prcPasteHeaders()
        Worksheets("Main").Select
        Range("A1").Select
        ActiveCell.Value = "Vendor"
            ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = "CompanyCode"
            ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = "Name"
            ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = "City"
            ActiveCell.Offset(0, 1).Select
            
        ActiveCell.Value = "Assignment"
            ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = "DocumentNo"
            ActiveCell.Offset(0, 2).Select
            
        ActiveCell.Value = "Type"
            ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = "DocDate"
            ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = "ClrngDoc"
            ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = "Currency"
            ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = "Amount"
            ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = "ClrngDate"
            ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = "PstngDate"
            ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = "NetDueDate"
            ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = "DocHeadText"
            ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = "BLineDate"
            ActiveCell.Offset(1, 0).Select
        ActiveCell.End(xlToLeft).Select
        strMCRow = ActiveCell.Address
        blTitles = True
End Sub

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

 

Sub prcPasteData()
Dim strCAddr As String
Dim intI As Long, intJ As Long
Dim bl2Star As Boolean

intJ = 2
For intI = 1 To strCRow
    If Range("X" & intI).Value = "VE" Then
        strVendor = Range("E" & intI).Value
    ElseIf Range("X" & intI).Value = "CC" Then
        strCCode = Range("E" & intI).Value
    ElseIf Range("X" & intI).Value = "NM" Then
        strName = Range("E" & intI).Value
    ElseIf Range("X" & intI).Value = "CT" Then
        strCity = Range("E" & intI).Value
    ElseIf Range("X" & intI).Value = "CP" Then
        Range("C" & intI & ".." & "S" & intI).Select
        Range("C" & intI & ".." & "S" & intI).Copy
        Worksheets("Main").Activate
            prcPasteConstants
            Range(strMCRow).PasteSpecial xlPasteValues
                ActiveCell.Offset(1, 0).Select
                ActiveCell.End(xlToLeft).Select
        Worksheets("0110").Activate
        j = j + 1
    End If
    Application.StatusBar = "Writing content onto: " & intI & "row..."
Next

End Sub

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

 

Sub prcPasteConstants()
    ActiveCell.Value = strVendor
        ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = strCCode
        ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = strName
        ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = strCity
        ActiveCell.Offset(0, 1).Select
    strMCRow = ActiveCell.Address
End Sub

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

gallery/rawdata_output

Output Sheet:

Macro Assigned - Code Window

gallery/rawdata_macroassigned