Question

New to VBA, so be gentle.

I have a 7 columns, A:H. The first column is a unique numerical identifier (starts at 0 and should increase each time I paste a new selection via this macro). The second column is Date which is entered in by hand after being prompted.

I want to be able to highlight a range of cells, activate the macro, and the macro move the data highlighted and paste it in next available chunk of space between the C and I columns. At the beginning, the macro prompts a dialog box asks the user for the date. I want this date to be entered at each point along Column B (in the next empty cell) for each cell in the selection.

Here are how the columns are formatted now: https://i.stack.imgur.com/jtVBg.png

Then, for each cell in the selection, I want it to be associated with a numerical ID. So the script would look to see what the last number was in column A, add one to that, and paste that for each cell in the current selection.

Here’s my code, but as I’m new to this, it’s completely broken.

For the DialogBox:

Sub SuperMacro()

    Dim c As Object
    Dim dateManager As String
    dateManager = InputBox(Prompt:="Enter the Date for Selection", _
          Title:="Date Manager", Default:="1/24/2013")

    If strName = "Your Name here" Or _
        strName = vbNullString Then
        Exit Sub
    End If

    For Each c In Selection
        Range("A1").End(xlDown).Offset(1, 0).Select  'Paste the date for each cell in selection
        ActiveSheet.Paste
    Next c

     'Attempt to move all date from selected area to next available chunk of space between C1 and H1.  
     Selection.Copy
     Range("C1:H1").End(xlDown).Offset(1, 0).Select
     ActiveSheet.Paste

End Sub

EDIT: Figured out a solution for the ID enumeration issue and column movement:

Sub CopyTest()

    Dim a As Range, b As Range
    Dim value As Integer

    Selection.Copy
    Set a = Selection
    Range("B1:H1").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    value = (Range("A1").End(xlDown)) + 1
    For Each b In a.Rows
        Range("A1").End(xlDown).Offset(1, 0).Select
        ActiveCell.value = value
    Next

End Sub

Let me know if there is a more efficient way of doing this.

FOund a solution myself, for others:

Sub SuperMacro()

Dim a As Range, b As Range
Dim currentID As Integer


Set a = Selection
Selection.Cut Range("C1:I1").End(xlDown).Offset(1, 0) 'Pastes to appropriate column


currentID = Range("A1").End(xlDown).Value


For Each b In a.Rows
    Range("A1").End(xlDown).Offset(1, 0) = currentID + 1
    Range("B1").End(xlDown).Offset(1, 0) = InputBox("Enter Date", "Date Helper")
Next b

End Sub

Answer 1

Here’s the answer I found:

Dim a As Range, b As Range
Dim currentID As Integer


Set a = Selection
Selection.Cut Range("C1:I1").End(xlDown).Offset(1, 0) 'Pastes to appropriate column


currentID = Range("A1").End(xlDown).Value


For Each b In a.Rows
    Range("A1").End(xlDown).Offset(1, 0) = currentID + 1
    Range("B1").End(xlDown).Offset(1, 0) = InputBox("Enter Date", "Date Helper")
Next b

End Sub