• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 82
  • Last Modified:

macro to Modify Excel Spreadsheet

Hello,

I would like to modify a Spreadsheet that is preconfigured to export from the software in the below way:

Excel 1 non formattte

then I would like it to format in the following way:

Excel 2 Formatted

The person may have more than one Badge ID so it could be 2 or 3 or 4 like the Cray, Acie has, it just depends.

don't know if there is a way to produce this?  Maybe by a macro or VBA? something?  I have perhaps, thousands.
0
Ernest Grogg
Asked:
Ernest Grogg
1 Solution
 
Martin LissOlder than dirtCommented:
Please post a sample workbook.
0
 
KoenChange and Transition ManagerCommented:
try this:

Sub Macro1()
'
' Macro1 Macro
'

'
    Sheets("Sheetname").Select
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Name"
    Range("B2").Select
    Do While ActiveCell.Value <> "" And ActiveCell.Offset(1, 0).Value <> ""
        Selection.Cut
        ActiveCell.Offset(0, -1).Range("A1").Select
        ActiveSheet.Paste
        ActiveCell.Offset(0, 1).Range("A1:F1").Select
        Selection.Delete Shift:=xlUp
        Do While ActiveCell.Offset(1, 0) <> ""
            ActiveCell.Offset(0, -1).Range("A1").Select
            Selection.Copy
            ActiveCell.Offset(1, 0).Range("A1").Select
            ActiveSheet.Paste
            ActiveCell.Offset(0, 1).Range("A1").Select
        Loop
        ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
        Selection.Delete Shift:=xlUp
        ActiveCell.Offset(0, 1).Range("A1").Select
    Loop
    
    End Sub

Open in new window

0
 
Glenn RayExcel VBA DeveloperCommented:
This code will parse your data.  It creates a new sheet with a name column, names for each Badge ID, and no blank rows.
Sub Parse_Badges()
    Dim lngLastRow As Long
        
    'Test that the active sheet is not already processed - or not expected layout
    If Range("A1").Value <> "Badge ID" Then
        MsgBox "Data set does not appear to be correct; Halting process.", vbCritical + vbOKOnly, "Error"
        Exit Sub
    End If
    
    'Test if there is already an existing parsed sheet in the workbook
    For sh = 1 To ActiveWorkbook.Sheets.Count
        If Sheets(sh).Name = "Badge List" Then
            MsgBox "There is already a processed sheet.  Please delete it then re-run.", vbCritical + vbOKOnly, "Badge List Already Exists"
            Exit Sub
        End If
    Next sh
    'Make a copy of the current sheet and process
    ActiveSheet.Copy before:=Sheets(1)
    Sheets(1).Name = "Badge List"
    
    lngLastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Value = "Name"
    Range("A1").Font.Bold = True
    Range("A2").Select
    Do Until ActiveCell.Row = lngLastRow
        If InStr(1, ActiveCell.Offset(0, 1).Value, ",", vbTextCompare) > 0 Then
            strName = ActiveCell.Offset(0, 1).Value
            ActiveCell.EntireRow.Delete
            lngLastRow = lngLastRow - 1
            ActiveCell.Value = strName
            ActiveCell.Offset(1, 0).Select
        ElseIf ActiveCell.Offset(0, 1) = "" Then
            ActiveCell.EntireRow.Delete
            lngLastRow = lngLastRow - 1
        Else
            ActiveCell.Value = strName
            ActiveCell.Offset(1, 0).Select
        End If
    Loop
    Range("A1").Select
    Selection.AutoFilter
    Columns("A:G").EntireColumn.AutoFit
    Range("A2").Select
    MsgBox "Done."
End Sub

Open in new window


I've attached an example file.  To test it, run on the "Original" sheet; it will create a new one called "Badge List".
EE-CreateBadgeList.xlsm
0
 
Ernest GroggAuthor Commented:
Works good.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now