Not split... break apart?

[Maarkr]

I have a data dump, and I need to break apart the column every time a value
(*dept*) shows in the first column:

finance dept
bob... ssn id-no
other data
sally...
(list of 15 more names)
mfg dept
joe...
bill...
(list of 30 more names)
payroll dept
lucie...
(list of 4 more names)
more depts with names...

so i need to loop thru the first column, and have each *dept* in it's own
new column or worksheet so I can print out each dept and other column info.
i've had suggestions to use 'split', but I'm not using the split function -
I need to break out each group of depts.

 

[Jacob Skaria]

Try out the below macro in a fresh workbook with your data in ColA/ColC
starting from row 1..


Sub MyMacro()
Dim ws As Worksheet, ws1 As Worksheet, lngRow As Long, lngSrow As Long
Set ws = ActiveSheet: Set ws1 = ws
For lngRow = 1 To ws.Cells(Rows.Count, "A").End(xlUp).Row + 1
If UCase(Right(ws.Range("A" & lngRow), 5)) = " DEPT" Then
If lngSrow = 0 Then
lngSrow = lngRow + 1
Else
Set ws1 = Worksheets.Add(After:=ws1)
ws.Range("A" & lngSrow & ":C" & lngRow - 1).Copy ws1.Range("A1")
ws1.Name = ws.Range("A" & lngSrow - 1): lngSrow = lngRow + 1
End If
End If
Next
Set ws1 = Worksheets.Add(After:=ws1)
ws.Range("A" & lngSrow & ":C" & lngRow - 1).Copy ws1.Range("A1")
ws1.Name = ws.Range("A" & lngSrow - 1)
End Sub

If this post helps click Yes

 

[Maarkr]

been looking on the web... would it be easier to just put a page break before
each *dept* ?

the code failed on
ws.Range("A" & lngSrow & ":C" & lngRow - 1).Copy ws1.Range("A1")

 

[Maarkr]

been looking but this doesn't work either... a page break may be easier.
Cells.PageBreak = xlPageBreakNone
col = 4
LastRw = 3300
For x = 30 To LastRw
If Cells(x, col).Value = " dept " Then
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Rows(x)
End If
Next
ActiveWindow.View = xlPageBreakPreview
'ActiveSheet.ResetAllPageBreaks

 

[Jacob Skaria]

I have copied your data and worked on the macro..Now let us try the below..

--copy paste he below data as such to Sheet1 ColA/C to starting from row1
--Run the macro...and see

Col A Col B Col C
finance dept head1 head2
finanacename1 fina1 hfin1
finanacename2 fina2 hfin2
finanacename3 fina3 hfin3
finanacename4 fina4 hfin4
finanacename5 fina5 hfin5
finanacename6 fina6 hfin6
admin dept
adminname1 admn1 hex1
adminname2 admn2 hex2
adminname3 admn3 hex3
adminname4 admn4 hex4
adminname5 admn5 hex5
adminname6 admn6 hex6
It dept
itdeptname1 itdd1 itab1
itdeptname2 itdd2 itab2
itdeptname3 itdd3 itab3
itdeptname4 itdd4 itab4
itdeptname5 itdd5 itab5
itdeptname6 itdd6 itab6

 

[Jacob Skaria]

I would like you to try this and feedback...

Sub MyMacro()
Dim ws As Worksheet, ws1 As Worksheet, lngRow As Long, lngSrow As Long
Set ws = ActiveSheet: Set ws1 = ws
For lngRow = 1 To ws.Cells(Rows.Count, "A").End(xlUp).Row + 1
If Instr(1, ws.Range("A" & lngRow) , " DEPT", vbTextCompare) > 0 Then
If lngSrow = 0 Then
lngSrow = lngRow + 1
Else
Set ws1 = Worksheets.Add(After:=ws1)
ws.Range("A" & lngSrow & ":C" & lngRow - 1).Copy ws1.Range("A1")
ws1.Name = ws.Range("A" & lngSrow - 1): lngSrow = lngRow + 1
End If
End If
Next
Set ws1 = Worksheets.Add(After:=ws1)
ws.Range("A" & lngSrow & ":C" & lngRow - 1).Copy ws1.Range("A1")
ws1.Name = ws.Range("A" & lngSrow - 1)
End Sub

If this post helps click Yes