PDA

View Full Version : Ranges



waqas
06-08-2015, 11:39 PM
I have below ranges. Its randomly increased or decreased each range have its own color and value. There's merge also. If i use union it merge all together i have to merge max two two cells if it is in range. What i have to do if i click all ranges should select at once changed color put the value in all cells. I am using loops but it take time.

Range("AI77:AJ77,AI78:AJ78,AI79:AJ79,AI80:AJ80,AI81:AJ81,AI82:AJ82,AI83:AJ83,AI84: AJ84,AI85:AJ85,AI86:AJ86,AI87:AJ87,AI88:AJ88,AK86:AL86,AN35:AO35,AN36:AO36"), _

Range("AN43:AO43,AP50,AQ112:AR112,AQ113:AR113,AT103:AU103,AT104:AU104,AT105:AU105, AT106:AU106,AW76:AX76,AW77:AX77,AW78:AX78,AW79:AX79,AW80:AX80,AY34,AY40"), _

Range("AY42,AY43,BL49:BM49,BR58:BS58,BR59:BS59,BR66:BS66,BR67:BS67,BT36:BU36,CF47: CG47,CF48:CG48,CF51:CG51,CF55:CG55,CH52:CI52,CH53:CI53,CH54:CI54"), _

Range("CL36,CR60,CR61,CZ53:DA53,DA34:DB34,DA35:DB35,DA36:DB36,DA37:DB37,DA38:DB38, DM34:DN34,DO40:DP40,DS51:DT51,DW46,DX59:DY59,DX61:DY61"), _

Range("DX62:DY62,DY34,DY36,DY37,DY40,DY42,DY51:DZ51,DY54:DZ54,DZ35,DZ36,EA34:EB34, EA38:EB38,EA41:EB41,EA43:EB43,EA51:EB51"), _

Range("EA65,EB63:EC63,EB64:EC64,EC39,EC40,EE42:EF42,EE51:EF51,EG34,EG60,EI34:EJ34, EI36:EJ36,EI37:EJ37,EI39:EJ39,EI40:EJ40,EI42:EJ42"), _

Range("EI53:EJ53,EL105:EM105,EL106:EM106,EL107:EM107,EL108:EM108,EM38:EN38,EN108:E O108,EN109:EO109,EN110:EO110,EN111:EO111,EN112:EO112,EN113:EO113,EN114:EO11 4,EN115:EO115,EN116:EO116 "), _

Range("EN62:EO62,EN63:EO63,EQ35:ER35,EQ39:ER39,EQ46:ER46,EQ47:ER47,EQ48:ER48,EQ49: ER49,EQ50:ER50,EQ51:ER51,ER58:ES58,ER92,ES123:ET123,ES124,ES52:ET52"), _

Range("ES53:ET53,ES79,ES80,ES81,ES82,ES83,ES84,ES85,ET125,ET62:EU62,EU124:EV124,EV 61:EW61,EY38:EZ38,EZ89,EZ90"), _

Range("EZ91,FB64:FC64,FB65:FC65,FB66:FC66,FB79:FC79,FB80:FC80,FB81:FC81,FB82:FC82, FB83:FC83,FB84:FC84,FB85:FC85,FB86:FC86,FB87:FC87,FB88:FC88,FB89:FC89"), _

Range("FB90:FC90,FB91:FC91,FD62,FE34,FE41,FF58:FG58,FF59:FG59,FG41,FG43,FH102:FI10 2,FH103:FI103,FH104:FI104,FH105:FI105,FH106:FI106,FH80:FI80"), _

Range("FH81:FI81,FJ59,FJ63,FJ64,FJ65,FU30,FX23:FY23,FY16,FY17,FY19,GA37,GB12:GC12, GB13:GC13,GB16:GC16,GB24:GC24"), _

Range("GB58:GC58,GB64:GC64,GB66:GC66,GB67:GC67,GD17,GD34:GE34,GD40:GE40,GD43:GE43, GD62:GE62,GD63:GE63,GE29,GF35,GF36,GF37,GG30:GH30"), _

Range("GG41,GG42,GH10:GI10,GI50:GJ50,GI51:GJ51,GL13:GM13,GL14:GM14,GL43:GM43,GM31: GN31,GN36:GO36,GN39:GO39,GN40:GO40,GO25,GO31,GP34:GQ34"), _

Range("GP59:GQ59,GP64:GQ64,GQ14:GR14,GS16:GT16,GS61,GS66,GS67,GT51,GV42:GW42,GV43: GW43,GV46:GW46,GV49:GW49,GW22,GX52:GY52,GX55:GY55"), _

Range("GX59:GY59,GX61:GY61,GZ52,HB35:HC35,HB37:HC37,HB40:HC40,HB41:HC41,HB46:HC46, HB47:HC47,HB67:HC67,HD52:HE52,HE23:HF23,HF40:HG40,HF46:HG46,HF58:HG58"), _

Range("HG15,HG18,HG26:HH26,HH54,HH61:HI61,HH63:HI63,HH64:HI64,HH65:HI65,HH67:HI67, HI47,HI50,HT15:HU15,HW17,HW18,HX40"), _

Range("HY29:HZ29,HY30:HZ30,IC38:ID38,IC39:ID39,IC40:ID40,ID10,IE29:IF29,IE30:IF30, IE31:IF31,IE41:IF41,IF54:IG54,IH55:II55,IK22:IL22,IK46,IK47"), _

Range("IK48,IL49,IL50,IM28,IN36,IN37,IN40,IN41,IO23:IP23,IO28:IP28,IO29:IP29,IO30: IP30,IP40,IP41,IP42"), _

Range("IP43,IQ10,IQ11,IQ12,IQ13,IQ14,IQ36:IR36,IQ37:IR37,IR49:IS49,IR53:IS53,IR54: IS54,IS17:IT17,IS22,IT58:IU58,IU10:IV10"), _

Range("IU11:IV11,IU12:IV12,IU13:IV13,IU16:IV16,IU17:IV17,IU18:IV18,IU19:IV19,IU51, IV53:IW53,IW58,IY31:IZ31,IZ50:JA50,IZ53:JA53,J37:K37,J38:K38"), _

Range("J39:K39,J40:K40,JA12:JB12,JA30:JB30,JB60:JC60,JC10:JD10,JC11:JD11,JC43,JD22 ,JD23,JD24,JD25,JD26,JD52:JE52,JD55:JE55"), _

Range("JD59:JE59,JF13,JF14,JF60,JF61,JH64:JI64,JI25:JJ25,JI26:JJ26,JI43:JJ43,JJ17, JK18:JL18,JL34,JL35,JL36,JL37"), _

Range("JL40,JL49:JM49,JM11,JM12,JN18,JN48,JN50,JO34,U106:V106,U107:V107,U108:V108, Z40:AA40,Z41:AA41,Z42:AA42,Z43:AA43")).Select

SamT
06-09-2015, 12:30 AM
You have a problem.

waqas
06-09-2015, 10:01 PM
You have a problem.

I have draw yard in excel where i put boxes with two sizes 20 and 40 feet. Single cell for 20 two cells for 40. These boxes are currently 12000. On different location. These references i am using to show box location. To select location i have to use ranges which can be one or in thousand. Now tell me how can i select these ranges.

SamT
06-10-2015, 04:23 AM
wagas,

I am sorry, did not mean to offend. You may call me Sam if you wish.

It sounds like you are at a shipping container yard. That is an interesting problem.

At this time, I think we need a Container Object or a Yard_Location Object, and maybe both Objects.

Tell me more about the business operation. About how it works. Why you have to select all those ranges at once. We here at the forum need to know some thing about the entire situation before we can try to find a solution.

SamT
As to your current question.

If you have permanent ranges you must use in code and if they are quite large, one method is to Select them on the sheet, then Name them with the Insert Menu >> Name >> Define Dialog. A (better?) alternative is to use a Helper Sheet with a list of names in one column and the addresses of the respective Ranges in the next column. There is a character count limit. IIRC, of 256 to the "value" of named Ranges. A cell has a character count limit of, IIRC, 32K, The same as a Code Module.

This little sub will let you put the addresses of any selected cells into a location so you can copy it into your code, or make the list mentioned.

Sub Get_Addresses()
Sheets("Sheet3").Range("B2") = Selection.Address
End Sub
To use it, hold down the Ctrl Key and Select all the Ranges you want the collective address for, then run the sub.

Paul_Hossler
06-10-2015, 06:57 AM
To select location i have to use ranges which can be one or in thousand. Now tell me how can i select these ranges.


Please explain why it is necessary to select ALL cells containing a box. Is it to count them or something?

waqas
06-10-2015, 10:44 AM
Please explain why it is necessary to select ALL cells containing a box. Is it to count them or something?

Dear Paul,
You can see in ranges there are single and two cells i have to change colors as per box colors and to put count of boxes in one place. In one location can be 1 or 5 boxes.

Paul_Hossler
06-11-2015, 05:47 AM
Can you attach a small example showing the various boxes and colors and counts and etc.

I was thinking that it might be possible to avoid selecting everything at once and just loop through the cells. For example if every cell(s) of interest has a fill, a macro could use that to do other processing



You can see in ranges there are single and two cells i have to change colors as per box colors and to put count of boxes in one place. In one location can be 1 or 5 boxes.

I can see the one or two cell ranges, but I'm not understanding the 'change color per box color' and where the 'count of boxes' goes. Does it go into each cell or in a master total on a different sheet?

waqas
06-12-2015, 11:03 AM
Can you attach a small example showing the various boxes and colors and counts and etc.

I was thinking that it might be possible to avoid selecting everything at once and just loop through the cells. For example if every cell(s) of interest has a fill, a macro could use that to do other processing

This is 10 mb file size


I can see the one or two cell ranges, but I'm not understanding the 'change color per box color' and where the 'count of boxes' goes. Does it go into each cell or in a master total on a different sheet?

waqas
06-12-2015, 11:31 AM
i am sending picture of my file and some code i am doing every thing through loop. it takes time approx 1 to 2 minute.
just i want to reduce the time with selection the ranges at once and changing the color.

when i started this project it takes time to complete same task 10 to 15 minute now it reduced only 1 to 2 minutes.

now i want to do when user select any option result should come with in seconds.



13677



Sub X() 'Name Unknown, SamT
Dim Conn As New ADODB.Connection, StrSql As String
Dim rs As New ADODB.Recordset, rscn As New ADODB.Recordset, RSMix As New ADODB.Recordset
Dim DBpath As String, sconnect As String, TRec As Integer, ContCategory As String, DatStr As Variant
Dim StackRs As New ADODB.Recordset, StkSql As String, CelRng As Range, Qty As Integer, rng As Variant, IMx As Integer
Dim BlkBR As String, OutRt As String
Option Base 1
Sub MixedCnt()
'** if i declare it glogely it bring previously value
Dim TxtRotSer As String
Application.ScreenUpdating = False

Sheets("FilterData").Activate
Columns("A:A").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select

Sheets("Data").Activate
Rows("1:1").Select
Selection.Copy
Sheets("FilterData").Select
Rows("1:1").Select
ActiveSheet.Paste
Range("A1").Select


Call ClearBlk


Sheets("RotColor").Range("A1:A30").ClearContents


'FrmYard.LstRot.Selected(Item) = True
For i = 0 To FrmYard.LstRot.ListCount - 1


If FrmYard.LstRot.Selected(i) Then
AB = AB + 1
Sheets("RotColor").Range("A" & AB).Value = FrmYard.LstRot.List(i)
TxtRotSer = TxtRotSer & ",'" & FrmYard.LstRot.List(i) & "'"


End If
Next


If TxtRotSer = "" Then
Exit Sub
Else
TxtRotSer = Right(TxtRotSer, Len(TxtRotSer) - 1)
End If

If FrmYard.OPTRot = True Then

StrSql = "Select * from [DATA$A1:BN65000] WHERE len(BlockBayRow) > 3 and OutRotation in (" & TxtRotSer & ");"
ConnDbase
ElseIf FrmYard.OptServ = True Then
StrSql = "Select * from [DATA$A1:BN65000] WHERE len(BlockBayRow) > 3 and Vservice in (" & TxtRotSer & ");"
ConnDbase
End If
'ElseIf FrmYard.OptFLYard = True Then
'StrSql = "Select * from [DATA$A1:BN65000] WHERE AddedLoc <>'-' ;"
'End If
End Sub



Sub ConnDbase()
DBpath = ThisWorkbook.FullName


sconnect = "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & DBpath & _
";Extended Properties=""Excel 12.0 XML; mACRO; HDR=Yes;"""


Conn.Open sconnect
rs.CursorLocation = adUseClient
rs.Open StrSql, Conn, adOpenStatic, adLockReadOnly




'*********** Make String
For Ary = 1 To rs.RecordCount

RecCnt = RecCnt + 1
Rcnt = RecCnt & " / " & rs.RecordCount
DatStr = DatStr & ",'" & rs.Fields(10) & "'"
rs.MoveNext
FrmYard.LblCnt.Caption = Rcnt
FrmYard.Repaint
Next Ary
If rs.RecordCount = 0 Then
MsgBox "No Record Found"
GoTo AB
End If
'**** Trim comma to make query accurate
DatStr = Right(DatStr, Len(DatStr) - 2)
DatStr = Left(DatStr, Len(DatStr) - 1)



'mixsql = "Select * from [DATA$A1:BN65000] WHERE Vservice in (" & TxtRotSer & ") and BlockBayRow in ('" & DatStr & "' );"
'**** this query is to capture other service or rotation mixed in one row
mixsql = "Select * from [DATA$A1:BN65000] WHERE BlockBayRow in ('" & DatStr & "' );"


RSMix.CursorLocation = adUseClient
RSMix.Open mixsql, Conn, adOpenDynamic, adLockOptimistic
RSMix.Sort = "[OutRotation]"


TRec = RSMix.RecordCount
Sheets("FilterData").Activate
Sheets("FilterData").Range("b1000000").End(xlUp).Select
Sheets("FilterData").Range("a1000000").End(xlUp).Offset(1, 0).CopyFromRecordset RSMix


DatStr = ""
'*****************************************
StkSql = "Select distinct BlockBayRow from [FilterData$A1:BN65000]"
StackRs.CursorLocation = adUseClient
StackRs.Open StkSql, Conn, adOpenDynamic, adLockReadOnly
Sheets(1).Activate
GroundSlot = StackRs.RecordCount
Do Until StackRs.EOF
'dtsql = "Select count(*) from [FilterData$A1:BN65000] where BlockBayRow ='" & StackRs.Fields(0).Value & "'"
BlkBR = StackRs.Fields(0).Value
Call StackMix
'Sheets("Blk").Range("a1000000").End(xlUp).Offset(1, 0).CopyFromRecordset StackRs1
StackRs.MoveNext
Loop

StackRs.Close
Set StackRs = Nothing
rs.Close
RSMix.Close
Conn.Close
AB:
Set rs = Nothing
Set RSMix = Nothing
Set Conn = Nothing
DatStr = ""
Application.ScreenUpdating = True

End Sub

Paul_Hossler
06-13-2015, 09:15 AM
1. SamT - thanks

2. wagas - can you extract just the code that loops and add colors? It's make it a lot easier to look at the slow portion. I searched for .Interior to see where the color loop was but .Interior was not there

SamT
06-13-2015, 09:39 AM
I wonder if useing VBA to set Conditional formatting would work. Set the Conditions) to his "selection"(sic)

Paul_Hossler
06-13-2015, 02:40 PM
I wonder if useing VBA to set Conditional formatting would work. Set the Conditions) to his "selection"(sic)

I'm still struggling with why the entire group of cells needs to be selected at once in order to apply what I believe is just a .Interior.ColorIndex = something

SamT
06-13-2015, 03:24 PM
I am pretty sure that it is a container yard https://images.duckduckgo.com/iu/?u=http%3A%2F%2Fimages.veer.com%2Fstock-photos%2FShipping-container-storage-yard-aerial-PFP0007100.jpg&f=1
and he is trying to show the locations there in.

Paul_Hossler
06-13-2015, 04:21 PM
Yes, but why not container-by-container?

Why does it have to be all containers at once?

SamT
06-13-2015, 06:38 PM
If it was me, I would write a ShippingContainer Class with all the Properties needed, including the Location. I would also have a YardMap Class to translate those locations into Ranges.

That would make it soooo easy to write a program for.

Where is Container #156195602

WhereIs = ShippingContainers("156195602").Location

Show me on the Excel Map

YardMap.Range(ShippingContainers("156195602").Location)).Color = Red

Show me all the Merck Line Containers

Dim Ctnr As ShippingContainer
For Each Ctnr in ShippingContainers
If Ctnr.Owner = "Merck Lines" Then _
YardMap.Range(ShippingContainers(Ctnr).Location)).Color = Red
Next Ctnr

Store all the data in a Flat Data Base like a CSV file and use snb's fantastic little one liners when coding.

Waqas wants speed. How about less than a second for anything.