Thread: Criptic VB Code
View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.misc
El Bee El Bee is offline
external usenet poster
 
Posts: 58
Default Criptic VB Code

Jim,
I guess I should inclueded the entire SUB. All the wksheets are in the same
spreadsheet. The complete error is,
"Compile error: For control variable already in use."


Sub Step2_Extract_Profiles()
'
Dim Rng_1, Rng_2, Rng_3, Rng_4 As Integer
Dim ProgName, Levels As String


Sheets("Profiles").Activate
Range("B2").Select
paste_here = cell.Address

Sheets("Ecometry Data").Select
Range("A1").Select
Rng_1 = ActiveCell.Address
ActiveCell.SpecialCells(xlLastCell).Select
Rng_2 = ActiveCell.Address

Sheets("Programs").Select
Range(first_prog).Select
ProgName = ActiveCell.Value
cell.Offset(0, 1).Select
Levels = ActiveCell.Value

Sheets("Ecometry Security").Select
Range("A2").Select
Rng_3 = ActiveCell.Address
ActiveCell.SpecialCells(xlLastCell).Select
Rng_4 = ActiveCell.Address

For Each cell In Range(Rng_3, Rng_4)
If cell.Value = ProgName Then
If InStr(Levels, cell.Offset(0, 1).Select) Then
Selection.End(xlToLeft).Select ' get the logon name for search in
Ecometry Data wrksheet
logon = ActiveCell.Value
Sheets("Ecometry Data").Select
For Each cell In Range(Rng_1, Rng_2) ' search string "criptic
VB code"
If cell.Value = logon Then
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Copy_from = ActiveCell.Address
Sheets("Profiles").Activate
Range(paste_here).Select
Selection.PasteSpecial Paste:=xlPasteAll, operation:=xlNone, _
skipblanks:=False, Transpose:=True
cell.Offset(2, 13).Select
Range(Copy_from).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Profiles").Select
Selection.PasteSpecial Paste:=xlPasteAll, operation:=xlNone,
skipblanks:= _
False, Transpose:=True
Application.CutCopyMode = False
Range(past_here).Select
cell.Offset(0, 3).Select
paste_here = ActiveCell.Address
End If
Next cell
End If
End If
Next cell

Cells.Select
Cells.EntireColumn.AutoFit
Range("C2").Select
End Sub





"Jim Cone" wrote:


It can often help if you provide the Operating System and Excel version you are using.
Also specifying the exact error message received is a key.

That said, using the same range variable to loop thru nested loops can cause problems.
Use separate variables... maybe Cell and rCell.

Unless there is only one sheet involved, always prefix range call outs with
the appropriate workbook and sheet references...
Dim wb as Workbook
Dim ws as Worksheet
Set wb = Workbooks("Sludge")
Set ws = wb.Worksheets("Grease")

So this...
For Each cell In Range(rng_3, rng_4)
Could be...
For Each cell In ws.Range(rng_3, rng_4)
(the above assumes rng_3 and rng_4 are on ws)
Or...
For Each cell In rng_3.Parent.Range(rng_3, rng_4)

Practically any John Walkenbach book would ease the OJT.
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware
(Excel Add-ins / Excel Programming)



"El Bee"
wrote in message
Below I am attempting to write some VB code and I now get an error with the
second level of the statement "For Each cell in Range"
can I not have multiple levels of this command like I can with the "IF"
statement.
I really hate the OJT factor so any help with improving the code below would
also be GREATLY appreciated.

Thanks,

El Bee

************

For Each cell In Range(rng_3, rng_4)
If cell.Value = ProgName Then
If InStr(levels, cell.Offset(0, 1).Select) Then
Selection.End(xlToLeft).Select ' get the logon name for search in
Ecometry Data wrksheet
logon = ActiveCell.Value
Sheets("Ecometry Data").Select
For Each cell In Range(rng_1, rng_2)
If cell.Value = logon Then
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Copy_from = ActiveCell.Address
Sheets("Profiles").Activate
Range(paste_here).Select
Selection.PasteSpecial Paste:=xlPasteAll, operation:=xlNone, _
skipblanks:=False, Transpose:=True
cell.Offset(2, 13).Select
Range(Copy_from).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Profiles").Select
Selection.PasteSpecial Paste:=xlPasteAll, operation:=xlNone,
skipblanks:= _
False, Transpose:=True
Application.CutCopyMode = False
Range(past_here).Select
cell.Offset(0, 3).Select
paste_here = ActiveCell.Address
End If
Next cell
End If
End If
Next cell