You are here:

Excel/Excel 2003 move data from one column to a specific area based on another column

Advertisement


Question
Hello Tom,
I hope this finds you well.  Yolu have helped me greatly in the past and I am back for some more of your expertise.

I have a 2 Page spreadsheet in Excel 2003.

Page 1 is my information sheet
Col A is TeamName
Col B is Level
Col C is Special Request

I can have as many as 50 teams listed

Sheet 2 is my breakout sheet

Col A is A Level Team Names
Col B is Special Requests for that Team
Col F is B Level Team Names
Col G is Special Requests for that Team
Col K is C Level Team Names
Col L is Special Requests for that Team
Col P is W Level Team Names
Col Q is Special Requests for that Team

Team Entry starts at Row 27

I would like a macro to search through the team names on Page 1 and put them in the proper column on page 2, based on the Team Level from Page 1 and loop through all of the teams until finished.  This will allow me to automate the process of scheduling our Volleyball Rec. League much easier.

As an example:

Spikers  A  No Mondays
Setters  A
Sinkers  B  
Getters  W Mondays Only

The Script should place on Page 2, Col A Line 27 Spikers, Col B No Mondays

Col A Line 28 Setters, Col B nothing
Col F Line 27 Sinkers Col G Nothing
Col P Line 27 Getters Col Q Mondays Only.g

Any help with this is greatly appreciated.

Mike R.

Answer
Mike R,

I assume you Page 1 is named   Sheet1
I assume your Sheet 2 (Breakout sheet) is named Sheet2
Change the code to match you actual names.

I tested this with your data and it worked for me.

I assume Sheet1 data starts in row 2
I assume (as I understood you to say)  Sheet2 data will be placed starting in row 27.


Sub abc()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim rw1 As Long, rw2 As Long, rw2a As Long
Dim icol As Long, ltr As String
Dim cell As Range, r As Range
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
' set the row where the source data in sheet1 starts
rw1 = 2
' I understood you to say output data starts in row 27,
'    change if this is not correct
rw2 = 27

' identify data in sheet1 starting in rw1 value

Set r = sh1.Range("A" & rw1, sh1.Cells(sh1.Rows.Count, "A").End(xlUp))
' now loop through the data in column A of sheet1
For Each cell In r
 icol = 0
 ltr = UCase(cell.Offset(0, 1))
 If Len(Trim(ltr)) = 1 Then
  Select Case ltr
   Case "A"
     icol = 1  ' col A
   Case "B"
     icol = 6  ' col F
   Case "C"
     icol = 11 ' col K
   Case "W"
     icol = 16 ' col P
  End Select
  If icol > 0 Then
     rw2a = sh2.Cells(sh2.Rows.Count, icol).End(xlUp).Row
     If rw2a < rw2 Then rw2a = rw2
     If sh2.Cells(rw2a, icol) <> "" Then rw2a = rw2a + 1
     sh2.Cells(rw2a, icol) = cell
     sh2.Cells(rw2a, icol + 1) = cell.Offset(0, 2)
  End If
 End If
Next
End Sub


--
Regards,
Tom Ogilvy

About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here

Excel

All Answers


Answers by Expert:


Ask Experts

Volunteer


Tom Ogilvy

Expertise

Selected as an Excel MVP by Microsoft since 1999. Answering Excel questions in Allexperts since its inception in 2001. Able to answer questions on almost all aspects of Excel's internal capabilities. If seeking a VBA solution, please specify that in your question itself so I give you the answer you want. [Excel has weak protection - if you are distributing an application, I don't answer questions on how to protect your project from your users.]

Experience

Extensive experience.

Education/Credentials
Master of Science (MS) degree Operations Research (ORSA)

Awards and Honors
Microsoft MVP in Excel.

©2016 About.com. All rights reserved.