PDA

View Full Version : Solved: Macro for Insertion of Lines between data



kevindbn
02-08-2010, 05:04 AM
Hi Guys

I have a spreadsheet with the following data:
A001 6009896523
A001 6006587455
A002 6009658544
A002 6008745632
A002 6009874456
A003
etc
etc and the Alphabets in the 1st coloum can change to "B001" etc and so forth.
My spreadsheet starts from A001 and A001 can go up to T009, with variables in betweeen. The spreadsheet will follow Alphabetic numeric order. I currently have to manually insert 5 lines after each lot of A001's A002's etc . Can I have this automatically inserted after every Aphanumeric field.eg afer all the A001's insert 5 blank lines, after all the A002's, A003's etc in need 5 blank lines to be inserted.

There is no set numbers as they vaiy so i need a macro that will be able to check that as the number changes leave 5 lines... can anyone help please....

Thanks...

Kevin

GTO
02-08-2010, 05:33 AM
Hi Guys

I have a spreadsheet with the following data:
A001 6009896523
A001 6006587455
A002 6009658544
A002 6008745632
A002 6009874456
A003
etc
etc and the Alphabets in the 1st coloum can change to "B001" etc and so forth.

Greetings Kevin,

Welcome to vbaexpress :hi:

Just to clarify, in the above, A001 is in one column, and 6009896523 is in the next column?

Mark

kevindbn
02-08-2010, 05:59 AM
Greetings Kevin,

Welcome to vbaexpress :hi:

Just to clarify, in the above, A001 is in one column, and 6009896523 is in the next column?

Mark

Thanks for the welcome Mark

Thats correct Mark.

GTO
02-08-2010, 06:38 AM
Not well tested, but in a junk copy of your wb, try:


Option Explicit

Sub exa()
Dim lLRow As Long
Dim i As Long
Dim strCurVal
lLRow = Cells(Rows.Count, 1).End(xlUp).Row

Application.ScreenUpdating = False
For i = lLRow To 2 Step -1
If strCurVal = vbNullString Then
strCurVal = Cells(i, 1).Value
GoTo Skip
End If
If Not Cells(i, 1).Value = strCurVal Then
strCurVal = Cells(i, 1).Value
Rows(i + 1 & ":" & i + 5).Insert xlShiftDown
End If
Skip:
Next
Application.ScreenUpdating = True
End Sub


Hope that helps,

Mark

kevindbn
02-08-2010, 08:17 AM
Not well tested, but in a junk copy of your wb, try:


Option Explicit

Sub exa()
Dim lLRow As Long
Dim i As Long
Dim strCurVal
lLRow = Cells(Rows.Count, 1).End(xlUp).Row

Application.ScreenUpdating = False
For i = lLRow To 2 Step -1
If strCurVal = vbNullString Then
strCurVal = Cells(i, 1).Value
GoTo Skip
End If
If Not Cells(i, 1).Value = strCurVal Then
strCurVal = Cells(i, 1).Value
Rows(i + 1 & ":" & i + 5).Insert xlShiftDown
End If
Skip:
Next
Application.ScreenUpdating = True
End Sub


Hope that helps,

Mark

Thank you so much Mark.... worked like a dream..:thumb :thumb :thumb :thumb

really appreciate it.

Take care...

Kevin:beerchug:

GTO
02-09-2010, 12:36 AM
Hi Kevin,

To answer your request for an explanation, see if these comments in the code help :-)


Sub exa()
Dim lLRow As Long
Dim i As Long
Dim strCurVal

'// Find the last cell with data. //
lLRow = Cells(Rows.Count, 1).End(xlUp).Row

'// Kill screen repaints to speed up macro and stop eyes from bleeding... //
Application.ScreenUpdating = False

'// Loop from bottom row w/data to row 2 (presumes a header row). //
For i = lLRow To 2 Step -1
'// You should actually be able to move this above the loop and just use//
'// strCurVal = Cells(lLRow, 1).Value //
'// As written, we get a 'seed' value if you will. //
If strCurVal = vbNullString Then
strCurVal = Cells(i, 1).Value
GoTo Skip
End If

'// For all loops excepting the first lap, we check to see if the cell's//
'// value is different than the cells below. If it is, and as you have //
'// your alphanumeric vals grouped/sorted, then we can presume that teh //
'// different val indicates the last of a different record //
If Not Cells(i, 1).Value = strCurVal Then
strCurVal = Cells(i, 1).Value
Rows(i + 1 & ":" & i + 5).Insert xlShiftDown
End If
Skip:
Next
Application.ScreenUpdating = True
End Sub


Hope that helps,

Mark

drawworkhome
02-09-2010, 07:42 AM
hey mark you sent it to erik?

GTO
02-09-2010, 01:25 PM
hey mark you sent it to erik?

:doh:Errr? Not sure what I did, as I deleted PMs, but evidently my bad.

Sorry about that. :(