Macro to Insert Cells and Text

[Houstonwolf]

I utilize an online system that will allow mass input of data using information pasted into Excel in the following format:

Book1
	A	B	C	D
1	T79747
2	MLA101B2
3	Y
4
5	T79748
6	MLA101B2
7	Y
8
Sheet1

I drag down and copy Col A, right click into the online app and it enters all my data.

My problem is, I'm trying to create a macro that will take this data:

Book1
	A	B	C	D
9	T79749
10	T79750
11	T79751
12	T79752
13	T79753
14	T79754
15	T79755
16	T79756
17	T79757
18	T79758
19	T79759
20	T79760
21	T79761
22	T79762
23	T79763
24	T79764
25	T79765
26	T79766
Sheet1

and insert 3 cells beneath A9, insert text 'MLA101B2' in new A10, insert text 'Y' in new A11 and leave new A12 blank (or insert a space, doesn't matter), then tab down insert 3 cells beneath new A13 and insert the text as above. And so on. I have approximately 4460 data points to enter so this would be a huge time saver.

When I record the macro, all it does it reference the active cell. It doesn't capture the action of tabbing down to a different call.

I know it can be done, I just can't figure it out using the record macro method.

I'm sure it will require modifying the existing recorded macro or creating one from scratch, I just don't know what to enter.

Thanks!

 

[crimson_b1ade]

This might work. hold Alt+F11, insert a new module, paste the below code. Then close the vba ide. Hold Alt+F8, then select the TestIt macro. Note: the below macro is set to Sheet2 so you'll need to change it to whatever sheet you like.

Sub TestIt()
 
Application.ScreenUpdating = False
 
Dim LastRow As Long, i As Long
Dim ws As Worksheet
 
Set ws = Sheets("Sheet2")

LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
 
For i = LastRow To 2 Step -1
 
    Rows(i & ":" & i + 2).Insert Shift:=xlDown
    
    With ws
       .Range("A" & i) = "MLA101B2"
       .Range("A" & i + 1) = "Y"
    End With
 
Next
 
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
 
With ws
       .Range("A" & LastRow + 1) = "MLA101B2"
       .Range("A" & LastRow + 2) = "Y"
End With
 
Application.ScreenUpdating = True

End Sub

 

[Legacy 68668]

Let's see if this works

Sub test()
Dim myAreas As Areas, myArea As Range
Columns(1).Insert
With Range("b10", Range("b" & Rows.Count).End(xlUp)).Offset(, -1)
    .Formula = "=if(mod(row(),2)=1,1,""a"")"
    On Error Resume Next
    .SpecialCells(-4123, 1).Resize(3).EntireRow.Insert
    .SpecialCells(-4123, 2).Resize(3).EntireRow.Insert
End With
Columns(1).Delete
With Range("a10", Range("a" & Rows.Count).End(xlUp).Offset(3))
    Set myAreas = .SpecialCells(4).Areas
End With
If myAreas Is Nothing Then
    MsgBox "Doesn't work"
    Exit Sub
End If
For Each myArea In myAreas
    myArea.Resize(2).Value = [{"MLA101B2";"y"}]
Next
End Sub

 

[Houstonwolf]

Thanks for the replies. I will try them out later today or Monday.

I did come up wth a simple workround, but it requires much more work upfront.

Thanks, again.

 

[Houstonwolf]

This might work. hold Alt+F11, insert a new module, paste the below code. Then close the vba ide. Hold Alt+F8, then select the TestIt macro. Note: the below macro is set to Sheet2 so you'll need to change it to whatever sheet you like.

Interesting result. It seems to have inserted what I wanted, but it hid the rows that contain the original data and I can't unhide them(!)

This gives me something to start with, and I am grateful. If you know why the rows are locked in a hidden status, I would be interested in knowing that.

Thanks again for the response!

 

[Houstonwolf]

Let's see if this works

Sub test()
Dim myAreas As Areas, myArea As Range
Columns(1).Insert
With Range("b10", Range("b" & Rows.Count).End(xlUp)).Offset(, -1)
    .Formula = "=if(mod(row(),2)=1,1,""a"")"
    On Error Resume Next
    .SpecialCells(-4123, 1).Resize(3).EntireRow.Insert
    .SpecialCells(-4123, 2).Resize(3).EntireRow.Insert
End With
Columns(1).Delete
With Range("a10", Range("a" & Rows.Count).End(xlUp).Offset(3))
    Set myAreas = .SpecialCells(4).Areas
End With
If myAreas Is Nothing Then
    MsgBox "Doesn't work"
    Exit Sub
End If
For Each myArea In myAreas
    myArea.Resize(2).Value = [{"MLA101B2";"y"}]
Next
End Sub

This code returns "Doesn't work". I don't know enough about how your code is put together (It's my lack of knowledge, not your lack of sophistication) to understand where to start to make it work.

But thank you for trying to help me.

 

[Houstonwolf]

Interesting result. It seems to have inserted what I wanted, but it hid the rows that contain the original data and I can't unhide them(!)

This gives me something to start with, and I am grateful. If you know why the rows are locked in a hidden status, I would be interested in knowing that.

Thanks again for the response!

I had AutoFilter turned on. That's why it was hiding the rows. Once I turned it off, it worked almost flawelessly! Exactly what I needed!

Thank you so much!