Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Help, can you have two arrays?
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 16
Default Help, can you have two arrays?
Happy Friday Friends,

OK. I think I am in the home stretch on this project. Under the code that
ends with line: "OutSH.Cells(OutRow, "K").Value = .Cells(i, "O").Value", I
need to figure out how to add code that says basically:

If on sheet "Criteria" (CriteriaSH in the code) cell B5 = Yes, also copy
over the value in columns A, D, P, E, BP, BR, O, for rows (3, 18, 19, 43, 56,
57, 58, 59, 88) from sheet Master Template (Template SH in the Code) to
Internal Project Plan (OutSH) into same columns from the code above this
line.

I was thinking this would be accomplished with an Array but there is already
1 array below. How can I fix this?

Dim OutSH As Worksheet, TemplateSH As Worksheet, ce As Variant
Dim OutRow As Long, i As Long
Dim arr As Variant
Dim CopyRow As Boolean
Set OutSH = Sheets("Internal Project Plan")
Set TemplateSH = Sheets("Master Template")

'----------------- ADDED ------------------------------------
Dim CriteriaSH As Worksheet
Dim Timeline As Long
Set CriteriaSH = Sheets("Criteria")

Timeline = CriteriaSH.Range("B6")

If Timeline < 60 And _
Timeline < 90 And _
Timeline < 120 Then

MsgBox ("Incorrect TimeLine")
Exit Sub
End If
'----------------- END ------------------------------------


With TemplateSH
For i = 2 To 700
CopyRow = False
For Each ce In CriteriaSH.Range("B15:B80")
If ce = "Yes" Then

'------------------ CHANGED FROM WORKSHEET FUNCTION -------------
Dim C As Variant
Set C = TemplateSH.Rows("1:1").Find( _
what:=ce.Offset(0, -1).Value, _
LookIn:=xlValues, _
lookat:=xlWhole)
If C Is Nothing Then
MsgBox ("Could not find : " & _
ce.Offset(0, -1).Value)
Exit Sub
Else
If .Cells(i, C.Column).Value = "x" Then
CopyRow = True
Exit For
End If
End If
End If
Next ce

If CopyRow = True Then
OutRow = OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
OutSH.Cells(OutRow, "A").Value = .Cells(i, "A").Value
OutSH.Cells(OutRow, "B").Value = .Cells(i, "D").Value
OutSH.Cells(OutRow, "C").Value = .Cells(i, "P").Value
OutSH.Cells(OutRow, "D").Value = .Cells(i, "E").Value
OutSH.Cells(OutRow, "I").Value = .Cells(i, "BP").Value
OutSH.Cells(OutRow, "J").Value = .Cells(i, "BR").Value
OutSH.Cells(OutRow, "K").Value = .Cells(i, "O").Value

'--------------------------- New Code -----------------------
Select Case Timeline

Case 60
OutSH.Cells(OutRow, "E").Value = _
.Cells(i, "H").Value
Case 90
OutSH.Cells(OutRow, "E").Value = _
.Cells(i, "K").Value
Case 120
OutSH.Cells(OutRow, "E").Value = _
.Cells(i, "N").Value
End Select
End If
'---------------------------End ----------------------------- End If
Next i
End With


'----------------------------------------------------------------
Application.StatusBar = "Transferring Headings"
arr = Array(2, 16, 85, 97, 98, 111, 127, 145, 160, 185, 193, 196, 211,
241, 308, 329, 340, 433, 447, 451, 476, 522, 549, 568, 597)


'moved outrow to this location and added counter inside loop
OutRow = OutSH.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
With TemplateSH
For i = LBound(arr) To UBound(arr)

.Cells(arr(i), "A").Copy _
Destination:=OutSH.Cells(OutRow, "A")

'Duplicate of above row, eliminate
'OutSH.Cells(OutRow, "A").Value = .Cells(arr(i), "A").Value

.Cells(arr(i), "D").Copy _
Destination:=OutSH.Cells(OutRow, "B")

'Duplicate of above row, eliminate
'OutSH.Cells(OutRow, "B").Value = .Cells(arr(i), "D").Value

.Cells(arr(i), "J").Copy _
Destination:=OutSH.Cells(OutRow, "C")

'Duplicate of above row, eliminate
'OutSH.Cells(OutRow, "C").Value = .Cells(arr(i), "J").Value

.Cells(arr(i), "E").Copy _
Destination:=OutSH.Cells(OutRow, "D")

'Duplicate of above row, eliminate
'OutSH.Cells(OutRow, "D").Value = .Cells(arr(i), "E").Value


.Cells(arr(i), "BP").Copy _
Destination:=OutSH.Cells(OutRow, "I")

'Duplicate of above row, eliminate
'OutSH.Cells(OutRow, "I").Value = .Cells(arr(i), "BQ").Value

'added row below
OutRow = OutRow + 1
Next i
End With
'sort output data
Application.StatusBar = "Sorting Output"
With OutSH
'-------------------------- CHANGED ------------------------------
'change this statement
.Range("A6:J" & (OutRow - 1)).Sort _
key1:=.Range("A6"), _
order1:=xlAscending, _
header:=xlYes
'---------------------------- ENd ---------------------------------
End With
Application.StatusBar = False

Sheets("Internal Project Plan").Select

Call Colors

Call Module6.SaveAs
End Sub

Thanks



--
Danielle :<)
Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default Help, can you have two arrays?
Yes you can have lots of Arrays. I added some code below. The lines I added
have the word "ADDED" as a comment. I don't understand what you are trying
to do. I went back to the spreadsheet you e-mailed me and wasn't able to
understand what you want to do. I wan't sure if you were refering to the top
portion of your code or bottom section of the code where you are copying the
headers. It seems like you want to copy to add two rows of data when B5 is
Yes but not sure whre the data is coming from.

Re-read your instructions and see if you can add more details. Remember I
have you old spreadsheet which will help. You can e-mail me if you want
instead of posting the information.



Dim OutSH As Worksheet, TemplateSH As Worksheet, ce As Variant
Dim OutRow As Long, i As Long
Dim arr As Variant
Dim arr2 As Variant '<= Added
Dim CopyRow As Boolean
Set OutSH = Sheets("Internal Project Plan")
Set TemplateSH = Sheets("Master Template")

'----------------- ADDED ------------------------------------
Dim CriteriaSH As Worksheet
Dim Timeline As Long
Dim Criteria as string
Set CriteriaSH = Sheets("Criteria")

Criteria = CriteriaSH.Range("B5")
Timeline = Ucase(CriteriaSH.Range("B6") )

If Timeline < 60 And _
Timeline < 90 And _
Timeline < 120 Then

MsgBox ("Incorrect TimeLine")
Exit Sub
End If
'----------------- END ------------------------------------


With TemplateSH
For i = 2 To 700
CopyRow = False
For Each ce In CriteriaSH.Range("B15:B80")
If ce = "Yes" Then

'------------------ CHANGED FROM WORKSHEET FUNCTION -------------
Dim C As Variant
Set C = TemplateSH.Rows("1:1").Find( _
what:=ce.Offset(0, -1).Value, _
LookIn:=xlValues, _
lookat:=xlWhole)
If C Is Nothing Then
MsgBox ("Could not find : " & _
ce.Offset(0, -1).Value)
Exit Sub
Else
If .Cells(i, C.Column).Value = "x" Then
CopyRow = True
Exit For
End If
End If
End If
Next ce

If CopyRow = True Then
OutRow = OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
OutSH.Cells(OutRow, "A").Value = .Cells(i, "A").Value
OutSH.Cells(OutRow, "B").Value = .Cells(i, "D").Value
OutSH.Cells(OutRow, "C").Value = .Cells(i, "P").Value
OutSH.Cells(OutRow, "D").Value = .Cells(i, "E").Value
OutSH.Cells(OutRow, "I").Value = .Cells(i, "BP").Value
OutSH.Cells(OutRow, "J").Value = .Cells(i, "BR").Value
OutSH.Cells(OutRow, "K").Value = .Cells(i, "O").Value
if Criteria = "YES" '<= Added

end if '<= Added
'--------------------------- New Code -----------------------
Select Case Timeline

Case 60
OutSH.Cells(OutRow, "E").Value = _
.Cells(i, "H").Value
Case 90
OutSH.Cells(OutRow, "E").Value = _
.Cells(i, "K").Value
Case 120
OutSH.Cells(OutRow, "E").Value = _
.Cells(i, "N").Value
End Select
End If
'---------------------------End ----------------------------- End If
Next i
End With


'----------------------------------------------------------------
Application.StatusBar = "Transferring Headings"
arr = Array(2, 16, 85, 97, 98, 111, 127, 145, 160, 185, 193, 196, 211,
241, 308, 329, 340, 433, 447, 451, 476, 522, 549, 568, 597)
arr2 = Array(3, 18, 19, 43, 56, 57, 58, 59, 88) '<= Added

'moved outrow to this location and added counter inside loop
OutRow = OutSH.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
With TemplateSH
For i = LBound(arr) To UBound(arr)

.Cells(arr(i), "A").Copy _
Destination:=OutSH.Cells(OutRow, "A")

'Duplicate of above row, eliminate
'OutSH.Cells(OutRow, "A").Value = .Cells(arr(i), "A").Value

.Cells(arr(i), "D").Copy _
Destination:=OutSH.Cells(OutRow, "B")

'Duplicate of above row, eliminate
'OutSH.Cells(OutRow, "B").Value = .Cells(arr(i), "D").Value

.Cells(arr(i), "J").Copy _
Destination:=OutSH.Cells(OutRow, "C")

'Duplicate of above row, eliminate
'OutSH.Cells(OutRow, "C").Value = .Cells(arr(i), "J").Value

.Cells(arr(i), "E").Copy _
Destination:=OutSH.Cells(OutRow, "D")

'Duplicate of above row, eliminate
'OutSH.Cells(OutRow, "D").Value = .Cells(arr(i), "E").Value


.Cells(arr(i), "BP").Copy _
Destination:=OutSH.Cells(OutRow, "I")

'Duplicate of above row, eliminate
'OutSH.Cells(OutRow, "I").Value = .Cells(arr(i), "BQ").Value

'added row below
OutRow = OutRow + 1
Next i
End With
'sort output data
Application.StatusBar = "Sorting Output"
With OutSH
'-------------------------- CHANGED ------------------------------
'change this statement
.Range("A6:J" & (OutRow - 1)).Sort _
key1:=.Range("A6"), _
order1:=xlAscending, _
header:=xlYes
'---------------------------- ENd ---------------------------------
End With
Application.StatusBar = False

Sheets("Internal Project Plan").Select

Call Colors

Call Module6.SaveAs
End Sub


"DanielleVBANewbie" wrote:

Happy Friday Friends,

OK. I think I am in the home stretch on this project. Under the code that
ends with line: "OutSH.Cells(OutRow, "K").Value = .Cells(i, "O").Value", I
need to figure out how to add code that says basically:

If on sheet "Criteria" (CriteriaSH in the code) cell B5 = Yes, also copy
over the value in columns A, D, P, E, BP, BR, O, for rows (3, 18, 19, 43, 56,
57, 58, 59, 88) from sheet Master Template (Template SH in the Code) to
Internal Project Plan (OutSH) into same columns from the code above this
line.

I was thinking this would be accomplished with an Array but there is already
1 array below. How can I fix this?

Dim OutSH As Worksheet, TemplateSH As Worksheet, ce As Variant
Dim OutRow As Long, i As Long
Dim arr As Variant
Dim CopyRow As Boolean
Set OutSH = Sheets("Internal Project Plan")
Set TemplateSH = Sheets("Master Template")

'----------------- ADDED ------------------------------------
Dim CriteriaSH As Worksheet
Dim Timeline As Long
Set CriteriaSH = Sheets("Criteria")

Timeline = CriteriaSH.Range("B6")

If Timeline < 60 And _
Timeline < 90 And _
Timeline < 120 Then

MsgBox ("Incorrect TimeLine")
Exit Sub
End If
'----------------- END ------------------------------------


With TemplateSH
For i = 2 To 700
CopyRow = False
For Each ce In CriteriaSH.Range("B15:B80")
If ce = "Yes" Then

'------------------ CHANGED FROM WORKSHEET FUNCTION -------------
Dim C As Variant
Set C = TemplateSH.Rows("1:1").Find( _
what:=ce.Offset(0, -1).Value, _
LookIn:=xlValues, _
lookat:=xlWhole)
If C Is Nothing Then
MsgBox ("Could not find : " & _
ce.Offset(0, -1).Value)
Exit Sub
Else
If .Cells(i, C.Column).Value = "x" Then
CopyRow = True
Exit For
End If
End If
End If
Next ce

If CopyRow = True Then
OutRow = OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
OutSH.Cells(OutRow, "A").Value = .Cells(i, "A").Value
OutSH.Cells(OutRow, "B").Value = .Cells(i, "D").Value
OutSH.Cells(OutRow, "C").Value = .Cells(i, "P").Value
OutSH.Cells(OutRow, "D").Value = .Cells(i, "E").Value
OutSH.Cells(OutRow, "I").Value = .Cells(i, "BP").Value
OutSH.Cells(OutRow, "J").Value = .Cells(i, "BR").Value
OutSH.Cells(OutRow, "K").Value = .Cells(i, "O").Value

'--------------------------- New Code -----------------------
Select Case Timeline

Case 60
OutSH.Cells(OutRow, "E").Value = _
.Cells(i, "H").Value
Case 90
OutSH.Cells(OutRow, "E").Value = _
.Cells(i, "K").Value
Case 120
OutSH.Cells(OutRow, "E").Value = _
.Cells(i, "N").Value
End Select
End If
'---------------------------End ----------------------------- End If
Next i
End With


'----------------------------------------------------------------
Application.StatusBar = "Transferring Headings"
arr = Array(2, 16, 85, 97, 98, 111, 127, 145, 160, 185, 193, 196, 211,
241, 308, 329, 340, 433, 447, 451, 476, 522, 549, 568, 597)


'moved outrow to this location and added counter inside loop
OutRow = OutSH.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
With TemplateSH
For i = LBound(arr) To UBound(arr)

.Cells(arr(i), "A").Copy _
Destination:=OutSH.Cells(OutRow, "A")

'Duplicate of above row, eliminate
'OutSH.Cells(OutRow, "A").Value = .Cells(arr(i), "A").Value

.Cells(arr(i), "D").Copy _
Destination:=OutSH.Cells(OutRow, "B")

'Duplicate of above row, eliminate
'OutSH.Cells(OutRow, "B").Value = .Cells(arr(i), "D").Value

.Cells(arr(i), "J").Copy _
Destination:=OutSH.Cells(OutRow, "C")

'Duplicate of above row, eliminate
'OutSH.Cells(OutRow, "C").Value = .Cells(arr(i), "J").Value

.Cells(arr(i), "E").Copy _
Destination:=OutSH.Cells(OutRow, "D")

'Duplicate of above row, eliminate
'OutSH.Cells(OutRow, "D").Value = .Cells(arr(i), "E").Value


.Cells(arr(i), "BP").Copy _
Destination:=OutSH.Cells(OutRow, "I")

'Duplicate of above row, eliminate
'OutSH.Cells(OutRow, "I").Value = .Cells(arr(i), "BQ").Value

'added row below
OutRow = OutRow + 1
Next i
End With
'sort output data
Application.StatusBar = "Sorting Output"
With OutSH
'-------------------------- CHANGED ------------------------------
'change this statement
.Range("A6:J" & (OutRow - 1)).Sort _
key1:=.Range("A6"), _
order1:=xlAscending, _
header:=xlYes
'---------------------------- ENd ---------------------------------
End With
Application.StatusBar = False

Sheets("Internal Project Plan").Select

Call Colors

Call Module6.SaveAs
End Sub

Thanks



--
Danielle :<)
Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Trouble with arrays (transferring values between two arrays) Keith R[_2_] Excel Programming 4 November 14th 07 12:00 AM
Working with ranges in arrays... or an introduction to arrays Glen Excel Programming 5 September 10th 06 08:32 AM
Arrays - declaration, adding values to arrays and calculation Maxi[_2_] Excel Programming 1 August 17th 06 04:13 PM
Arrays Chip Pearson Excel Programming 0 February 3rd 04 07:35 PM
arrays again RobcPettit Excel Programming 3 January 24th 04 10:33 PM


All times are GMT +1. The time now is 08:11 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement