To organize the excel file and also get the ranges of values from database

mahydusa

New member
Joined
Oct 27, 2011
Messages
1
Reaction score
0
Points
0
My input is Excel file --

CPT ICDCOVERED
87088 003.1 -- some cells have only single values
038.0,038.10-038.11,038.19,038.2,038.3,038.40-038.44,038.49,038.8,038.9 -- some cells have both comma ',' seperated as well as ranges ' - '
276.2, 278.1 -- some values are comma seperated
276.4 - 276.9 --some values are ranges separeted by ' - ' ranges
286.6
88037 034.02, 103.04 -- when there is comma beween the values it should load the values in seperate cells.
023.01, 123.03
201.01-201.04 -- when there is range it should connect to the DB(SQL SERVER) get the range of values and load them seperately in each cell with its corresponding values of CPT (fisrt column)

Excepted Output Excel file---

CPT ICDCOVERED
87088 003.1
87088 038.0
87088 38.10-038.110 -- when there is range it should connect to the DB(SQL SERVER) get the range of values and load them seperately in each cell
87088 038.19
87088 038.2
87088 038.3
87088 038.40-038.44 -- when there is range it should connect to the DB(SQL SERVER) get the range of values and load them seperately in each cell
87088 038.49
87088 038.8
87088 038.9
87088 276.2
87088 278.1
87088 276.4
87088 286.6
88037 034.02
88037 103.04
88037 023.01
88037 123.03
88037 201.01-201.04 -- when there is range it should connect to the DB(SQL SERVER) get the range of values and load them seperately in each cell

I need to organize the Excel before I am using a ELT tool to load the values from Excel to SQL SERVER, but first I need to organize the Excel values so that it can be loaded properly.

I am also attaching the Excel sample file.

Thanks , I would really appreciate your help.
Ali
 

Attachments

  • Sample_Excel_File.xlsx
    11.7 KB · Views: 36

Ken Puls

Administrator
Staff member
Joined
Mar 13, 2011
Messages
2,522
Reaction score
6
Points
38
Location
Nanaimo, BC, Canada
Website
www.excelguru.ca
Excel Version(s)
Excel Office 365 Insider
Hi Ali,

I don't know what to do with the ranges, as I don't have access to your server, but try the following code to do the rest:

Code:
Option Explicit
Sub BuildList()
    Dim lRow As Long
    Dim lCRow As Long
    Dim lCol As Long
    Dim lCols As Long
    Dim lCPT As Long
    Dim cl As Range
    Dim rngExamine As Range
    
    Application.ScreenUpdating = False
    
    With ActiveSheet
        'Split text into columns
        With .Columns("B:B")
            .TextToColumns _
                    Destination:=Range("B1"), _
                    DataType:=xlDelimited, _
                    Comma:=True
            .NumberFormat = "@"
        End With
        'Check each cell in range for multiple entries
        Set rngExamine = .Range("B2:B" & .Range("B1").End(xlDown).Row)
        For Each cl In rngExamine
            'Cache CPT if required
            If cl.Offset(0, -1).Value <> vbNullString Then
                lCPT = cl.Offset(0, -1).Value
            End If
            'Enforce number format
            cl.Value = CStr(EnsureNumberFormat(cl.Value))
            cl.Offset(0, -1).Value = lCPT
            
            If cl.Offset(0, 1).Value <> vbNullString Then
                'Set counters
                lRow = cl.Row
                lCRow = cl.Row
                lCols = cl.End(xlToRight).Column - 2
                'Insert new rows and copy data in
                For lCol = 1 To lCols
                    lRow = lRow + 1
                    .Rows(lRow).Insert
                    With .Range("B" & lRow)
                        .Value = CStr(EnsureNumberFormat(.Parent.Range("B" & lCRow).Offset(0, lCol).Value))
                        .Offset(0, -1).Value = lCPT
                    End With
                Next lCol
            End If
        Next cl
        'Clear information not required
        .Columns("C:Z").EntireColumn.Delete
    End With
End Sub
Function EnsureNumberFormat(sVal As String) As String
    Dim sPreface As String
    Dim sSuffix As String
    Dim lCount As Long
    'Check if decimal place exists
    lCount = InStr(1, sVal, ".")
    'Split into preface and suffix
    If lCount > 0 Then
        sPreface = Left(sVal, lCount - 1)
        sSuffix = "." & Right(sVal, Len(sVal) - lCount)
    Else
        sPreface = sVal
    End If
    'Pad with zeros if necessary
    lCount = Len(sPreface)
    Select Case lCount
        Case Is = 1
            EnsureNumberFormat = "00" & sPreface & sSuffix
        Case Is = 2
            EnsureNumberFormat = "0" & sPreface & sSuffix
        Case Is = 3
            EnsureNumberFormat = sVal
    End Select
End Function

Let me know how that works for you.
 
Top