Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Shaun E on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

I am trying to get the following pr 3

Status
Not open for further replies.

willyboy58

Technical User
May 29, 2003
86
US
I am trying to get the following procedure to read a row of information, find the cells in the row that are NOT empty (they will have a number in them) and then shift one column to the right and insert an “L” or an “H” (two separate procedures at this point) in the empty column to the right.

The brief worksheet looks like the following. A2 is the first activecell.

A B C D E F
1 name job 05-01-03 5-02-03
2 Bob 186 6.0
3 Steve 188 6.0
4 Mike 189 6.0
5 Frank 188 6.0

Row 1 is my headings: 2 on down is the employee name, job # and hours. Columns D and F are the empty columns to place an L or H into.

In the procedure below, if the value in the activecell in column B (above) is equal to 186 or 189 then I want an “L” in the empty column next to the hours in the row for that day (Bob and Mike, column D). If it is 188, then I want an “H” (Steve and Frank, column F). When it finishes with one row, it starts the next. I have the code (a different procedure) to count the number of entries across for each row, but I’m not sure how to tell it to go to the next row of info. The following is for the "L" only. I'll write a separate one for the "H".

Sub ActivateNextCellToRightL()
Dim LeaveHours As String
LeaveHours = "L"
ActiveCell.Offset(0, 1).Select
Do While IsEmpty(ActiveCell)
With ActiveCell
ActiveCell.Offset(0, 1).Select
LeaveHours = ActiveCell.Offset(0, 1).Select
End With
Loop
End Sub

The procedure above stops at each cell of info in the row, but it will not move to the next column (empty cell) to put the “L” into and then move across to the next cell. There will be about 30 columns of info. The above is only a small part of a much larger program.

Any help will be greatly appreciated. TIA. Bill
 
Zathras,

I was not able to get your last piece of advice to work for me. I must admit that my skills and understanding are not the best. I have tried to adapt some previous code (below) to get what I need. My current sheet looks like:
A B C D E
Name 5-01 5-02
Bob 7.0 6.0 H
Steve 6.0 H
Mike 6.0 L 6.0 H
Frank 6.0 H

The following is what I desire after updating the codes and removing the unneeded columns.
A B C D E
Name 5-01 5-02
Bob 7.0 H
Steve X H
Mike L H
Frank X H

For 5-01, Bob worked 7.0 hours, Steve and Frank did not receive anything (X’s), and Mike received Leave pay (L). On 5-02, everyone received Holiday pay (H). Please note that the L and H replace the hours number for the Leave and Holiday pay and the X fills in the cell where there are no hours whatsoever. The work hours (7.0 for Bob), stay on the sheet. The code I am trying to use follows:

Sub MoveCodesSatl()
Const COL_CODES = "A:AS"
Dim c As Range
Sheets("SATL-PT").Select
Range("A1").Select
For Each c In Intersect(ActiveSheet.UsedRange, Columns(COL_CODES))
Select Case c.Value
Case L: UpdateCode c, "L"
Case H: UpdateCode c, "H"
Case "": UpdateCode c, "X"
End Select
Next c
Range("A1").Select
Range("A1").EntireColumn.AutoFit
End Sub

Private Sub UpdateCode(ACell As Range, ACode As String)
Dim nCol As Integer
For nCol = 1 To 44 Step 2 'read every other cell
'start in Column A, jump B and begin calc'ng in C

If ACell.Offset(0, nCol) > "" Then
'looking for L or H in cell to copy
ACell.Offset(0, nCol - 1) = ACode
'move back one cell to insert L, H or X
End If
Next nCol
End Sub

Once again, as always, thanks for all the help. I’m close to success.

 
Ok, I think I understand. Try this:
[blue]
Code:
Option Explicit

Sub MoveCodesSatl()
Const COL_NAMES = "A:A"
Dim c As Range
Dim nCol As Integer
[green]
Code:
  ' Pull codes back on top of hours
[/color]
Code:
  Sheets("SATL-PT").Activate
  For Each c In Intersect(ActiveSheet.UsedRange, Columns(COL_NAMES))
    If c.Row > 1 Then
      CollapseCodesInOneRow c.Row
    End If
  Next c
[green]
Code:
  ' Delete unneeded columns
[/color]
Code:
  For nCol = 45 To 3 Step -2
    Cells(1, nCol).EntireColumn.Delete
  Next nCol
  Range("A1").Select
  Range("A1").EntireColumn.AutoFit
End Sub
  
Sub CollapseCodesInOneRow(ARow As Long)
Dim nCol As Integer
  For nCol = 2 To ActiveSheet.UsedRange.Columns.Count Step 2
    If Cells(ARow, nCol) = "" Then
[green]
Code:
      ' No time - mark with "X"
[/color]
Code:
      Cells(ARow, nCol).Value = "X"
    Else
[green]
Code:
      ' Time - overlay with code (if any)
[/color]
Code:
      If Cells(ARow, nCol + 1) <> &quot;&quot; Then
        Cells(ARow, nCol) = Cells(ARow, nCol + 1)
      End If
    End If
  Next nCol
End Sub
[/color]

 
Zathras,

ABSOLUTELY EXCELLENT!!

Next, I will count the number of days with hours, days with L's and days with H's. I have the code for doing that. I should be able to handle that. Then I will match employees with their pay rates from another table (i probably should have done this in Access) and get some totals.

I'll see if I can't do the rest myself.

AS ALWAYS, THANKS!!!!

Bill
 
Zathras,
I’ve got my different types of days counted w/o any problems and I am close to be finished. I have two more issues though. The first is with my Pivot Tables. When I first started this project, I did not stop to think and realize that each month the size of my data would be different (DUH!). So now I have to set my pivot tables to adjust to different sizes of ranges. The following is part of the original code produced by the recorded macro:

'ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= &quot;'Branch 3'!R1C1:R1646C5&quot;).CreatePivotTable TableDestination:=&quot;&quot;, TableName:=&quot;PivotTable6&quot;

Given that the range size can change, I changed my code to the following:
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
Activecell.CurrentRegion.Select).CreatePivotTable _
TableDestination:=&quot;&quot;, TableName:=&quot;PivotTable6&quot;

The new code selects the proper range of cells as it should, but I get the message: “Invalid procedure call or argument.” In the code module area, the little arrow to the left is at the line “ TableDestination:=&quot;&quot;, TableName:=&quot;PivotTable6&quot;. I started a different thread “Pivot Table Question” and got a response from Tony, but his code caused a different error message. It seems to me that the problem is in the line “ TableDestination:=&quot;&quot;, TableName:=&quot;PivotTable6&quot;, and probably in the TableDestination. What can I do to fix this?

My second issue is: Do you have or know anywhere where I can get some code to pull employee information from one sheet and match it to the employee information in the second sheet. The first sheet will have the employee number, name and hourly pay rate and the second sheet will have the information that I have been working on. I will need to copy the info from the first sheet and match and paste it to two new columns (name and pay rate) for the same employee (by number) on the second sheet. Then do some math.

As always, thanks a ton!!!




 
I've not played with Pivot tables in VBA, so I'm not really in a position to answer your questions. It does seem odd to me however, that you would want to be continually adding pivot tables to the PivotCaches collection. I should think you would be wanting to change the source for a given Pivot table, or something like that. In fact, the attempt to use the Add method with the same name as an existing Pivot Table (&quot;PivotTable6&quot;) is probably what's causing you to get an error message.

There are plenty of examples of code moving data between worksheets and/or using VLOOKUP. My suggestion is to look around here in the VBA forum or perhaps try the search facility.

 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top