Logo 
Search:

MS Office Answers

Ask Question   UnAnswered
Home » Forum » MS Office       RSS Feeds
  Question Asked By: Koila Malik   on Dec 18 In MS Office Category.

  
Question Answered By: Marion Hayes   on Dec 18

Here's a macro I wrote years ago for a similar purpose. There are 3 assumptions
built into the code which you can alter as needed:
1. The worksheet with the data  has exactly one row of headings, in row 1.
2. Every column of data has a heading.
3. The customer  name or number is in column A.

Sub SplitCustomers()
'Declare variables
Dim CellRef1 As Object, BaseSht As String
Dim a As Integer, x As Integer, MT As Integer
Dim CurrCust As String, PrevCust As String
Dim EndCol As Integer
BaseSht$ = ActiveSheet.Name
'ASSUMES sheet  HAS HEADINGS IN ROW 1 ONLY!
'ASSUMES CUSTOMER NAME/ID IS IN COLUMN A!
Range("A2").Activate
a% = ActiveCell.Row
PrevCust$ = ActiveCell.Value
'ASSUMES THERE IS A HEADING FOR EVERY COLUMN WITH DATA!
EndCol% = Cells(1, Columns.Count).End(xlToLeft).Column
MT% = 0
'Go to second row, first column. Walk down column A and test value of
'every cell. Stop when 100 consecutive empty cells are encountered.
Do While MT% < 100
Set CellRef1 = Cells(a%, 1)
CellRef1.Activate
CellRef1.Select
CurrCust$ = CellRef1.Value
'If the current cell is empty, add  1 to MT, the empty cell counter.
If CurrCust$ = "" Then
MT% = MT% + 1
Else
'If the current cell is not empty, reset MT. Check if its value
'(CurrCust$) is the same as the previous row (PrevCust$). If it's not
'the same, copy cols 1 through EndCol% for all the PrevCust$ rows (including
'row 1). Paste them onto a new sheet, then return to the original sheet
'(BaseSht$). Delete all the PrevCust$ rows (but not row 1). Assign the new
'CurrCust$ to PrevCust$. Reset a% to 1 (first row. Will then increment
'it).
MT% = 0
If CurrCust$ <> PrevCust$ Then
Range(Cells(1, 1), Cells(a% - 1, EndCol%)).Select
Selection.Copy
Sheets.Add
ActiveSheet.Paste
ActiveSheet.Name = Cells(2, 1).Value
Sheets(BaseSht$).Activate
Range(Cells(2, 1), Cells(a% - 1, EndCol%)).Select
Selection.EntireRow.Delete
PrevCust$ = CurrCust$
a% = 1
End If
End If
a% = a% + 1
Loop
End Sub

If you paste this code into a code module in its own workbook, then to run it
you should:
1. Open the workbook with the macro.
2. Open the workbook with the AS/400 data. Make sure the correct sheet is
active by clicking in any cell on that sheet.
3. Run the SplitCustomers macro (Tools >> Macro >> Macros... Select
SplitCustomers, then click Run).

Share: 

 

This Question has 1 more answer(s). View Complete Question Thread

 
Didn't find what you were looking for? Find more on Excel Help - important. Or get search suggestion and latest updates.


Tagged: