There is a table of three columns and ~9,400 rows listing beginning and end values for alpha-numeric ranges of codes along with a third value assigned to the ranges. It is desired to change the two columns of range endpoints into a single column of explicitly listed (1:1) values. Can you think of a method to automate explicitly listing values within the ranges?
Current example row:
|---r1----|---r2----|ccs|
| 0106T | 0110T | 7 |
Desired output:
|--code-|ccs|
| 0106T | 7 |
| 0107T | 7 |
| 0108T | 7 |
| 0109T | 7 |
| 0110T | 7 |
This is stored in a MySQL database and Excel workbook, but any language or manor of manipulation is fine.
If it is only with a "T" this will work and is a good base to your full macro :
Sub Alpha()
Dim WsS As Worksheet
Set WsS = Worksheets("Source")
Dim WsR As Worksheet
Set WsR = DeleteAndAddSheet("Results")
For i = 2 To WsS.Range("A" & Rows.Count).End(xlUp).Row
For k = Val(WsS.Cells(i, 1)) To Val(WsS.Cells(i, 2))
WsR.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = k & "T " & WsS.Cells(i, 3)
Next k
Next i
End Sub
Useful function for Sheets :
Public Function DeleteAndAddSheet(ByVal SheetName As String) As Worksheet
For Each aShe In Sheets
If aShe.Name <> SheetName Then
Else
Application.DisplayAlerts = False
aShe.Delete
Application.DisplayAlerts = True
Exit For
End If
Next aShe
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = SheetName
Set DeleteAndAddSheet = ThisWorkbook.Worksheets(Worksheets.Count)
End Function
Collected from the Internet
Please contact [email protected] to delete if infringement.
Comments