Looping to update another sheet

B

Billy B

This is my first attempt to program in Excel and I have hit a brick wall.

I have data on sheet(1) that looks like this:

Category Name Org Page Keyword (This row is column
titles)
Student Timothy WWC 1 Tim (Row begins
data(Sheet1 A5)
Carmen SFCC 1 Car
William CBCC 2 Bill
Sheryl PCC 2 Sherry
Thomas RRC 2 Tom
Instructor Wallace BMCC 1 Wally
etc.....

What I am trying to do is get the category, concantenate the names with ;
and a space, concantenate the org with ; and a space, the page and
concantenate the keyword with ; and space and update the information on
sheet(2). There would be a new line for each page under each category. The
result on page 2 would look like this:

Category Name Org
Page Keyword
Student Timothy; Carmen WWC; SFCC 1 Tim;
Car
William; Sheryl; Thomas CBCC; PCC; RRC 2
Bill; Sherry; Tom
Instructor Wallace; BMCC; 1
Wally;

etc.
No blank lines between the categories an if each label line is blank exit
the sub.

Below is the code I have been working on:

Option Explicit
'create range variables for each column in sheet(1)
Dim rngS1Cat As Range, rngS1Nam As Range, rngS1Org As Range, rngS1Pg As
Range, rngS1Key As Range
Dim rngS2Cat As Range, rngS2Nam As Range, rngS2Org As Range, rngS2Pg As
Range, rngS2Key As Range

'create variables to hold values of the cells
Dim vs1Cat As Variant, vS1Nam As Variant, vS1Org As Variant, vS1Pg As
Variant, vS1Key As Variant
Dim vS2Cat As Variant, vS2Nam As Variant, vS2Org As Variant, vS2Pg As
Variant, vS2Key As Variant

'create variable as range and set range to count categories
Dim rngCountCat As Range, intThereIs As Integer

'create variable to replace row number in offset argument
Dim intRC1 As Integer, intRC2 As Integer, intRC3 As Integer, intRC4 As
Integer, intRC5 As Integer

Dim intCountCat As Integer

Private Sub cmdRunIt_Click()

'set variable to count categories
Set rngCountCat = Sheets(1).Range("A5:A65000")
intThereIs = Application.WorksheetFunction.CountA(rngCountCat)

intRC1 = 1
intRC2 = 2
intRC3 = 3
intRC4 = 4
intRC5 = 5

'Dim intColumnCounter As Integer

'create counter for for category loop
intCountCat = 1

'establish data in the first row of sheet(1)
Set rngS1Cat = Application.Sheets(1).Range("A5")
Set rngS2Cat = Application.Sheets(2).Range("A5")

Set rngS1Cat = rngS1Cat(intRC1, intRC1)

vs1Cat = rngS1Cat(intRC1, intRC1)

'establish references for data entry in sheet(2)
Set rngS2Cat = rngS2Cat(intRC1, intRC1)

vS2Cat = rngS2Cat(intRC1, intRC1)

'start processing of row data in sheet(1)

'check to see if this is a new category
Do Until vs1Cat = "" And vS1Nam = "" And vS1Org = "" And vS1Pg = "" And
vS1Key = ""
If vs1Cat <> "" And vS1Pg = "" Then 'this is a new category
Call Category(vs1Cat, vS1Pg)
Else
Call MakeList(rngS1Cat, rngS1Nam, rngS1Org, rngS1Key, vS1Nam,
vS1Org, _
vS1Pg, vS1Key, vS2Nam, vS2Org, vS2Pg, vS2Key)
End If

Loop
End Sub


Public Sub Category(vs1Cat, vS1Pg)

rngS2Cat.Value = vs1Cat
Sheets(1).Select

Set rngS2Cat = rngS2Cat(1, 1)
ActiveCell.Activate
vs1Cat = rngS1Cat.Value
vS1Pg = rngS1Cat(1, 4)
End Sub

Public Sub MakeList(rngS1Cat, rngS1Nam, rng1org, rngS1Key, vS1Nam, vS1Org, _
vS1Pg, vS1Key, vS2Nam, vS2Org, vS2Pg, vS2Key)
Dim strCompare As Variant

If vS1Nam = ҠAND vS1Org = ҠAND vS1Org = ҠAND vS1Pg = ҠAND vS1Key =
ҠThen
Exit Sub
End If

Set rngS1Cat = rngS1Cat(intRC1, intRC1)
Set rngS1Nam = rngS1Cat(intRC1, intRC2)
Set rngS1Org = rngS1Cat(intRC1, intRC3)
Set rngS1Pg = rngS1Cat(intRC1, intRC4)
Set rngS1Key = rngS1Cat(intRC1, intRC5)

vS1Nam = rngS1Nam
vS1Org = rngS1Org
vS1Pg = rngS1Pg
vS1Key = rngS1Key

Set rngS2Nam = rngS2Cat(intRC1, intRC2)
Set rngS2Org = rngS2Cat(intRC1, intRC3)
Set rngS2Pg = rngS2Cat(intRC1, intRC4)
Set rngS2Key = rngS2Cat(intRC1, intRC5)

rngS2Nam.Value = vS1Nam
rngS2Org.Value = vS1Org
rngS2Pg.Value = vS1Pg
rngS2Key.Value = vS1Key

vS2Nam = rngS2Cat(intRC1, intRC2)
vS2Org = rngS2Cat(intRC1, intRC3)
vS2Pg = rngS2Cat(intRC1, intRC4)
vS2Key = rngS2Cat(intRC1, intRC5)

'vS1Nam = rngS1Nam.Value
'vS1Org = rngS1Nam.Value
'vS1Key = rngS1Key.Value

strCompare = rngS1Cat(2, 1)

Do While strCompare = ""
Set rngS1Cat = rngS1Cat(2, 1)
rngS1Cat.Select
vS1Nam = vS2Nam & "; " & rngS1Nam
vS1Org = vS2Org & "; " & rngS1Cat
vS1Pg = rngS1Pg
vS1Key = vS2Key & "; " & rngS1Cat

rngS2Nam.Value = vS1Nam
rngS2Org.Value = vS1Org
rngS2Key.Value = vS1Key
Loop



End Sub
 
B

Billy B

I forgot to mention that the problem is in the MakeList procedure. The
Category procedure does work. Because I haven't been able to get the Makelist
to work, I am not sure the Category procedure works in the loop after the
Makelist is run.

Thank you. I have been working on this problem for over 2 days now.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top