Set Intersect line for multiple ranges is too long - excel

The below code will not work because the Set isect line is too long and I cannot figure out how to make it a multiple line code. I have tried space (_) and enter.
If I make the line multiple lines starting with Set isect = Application.Intersect (Target, Range ()) it will only work on the last line of code.
The intent of the Excel sheet is to make a popup requiring data input if the selected cell has no as an answer. The required remarks would go into the cell to the right.
How do I split the Set isect line into multiple lines?
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Rows.Count > 1 Or Target.Columns.Count > 1 Then
Exit Sub
End If
Dim com As String
Dim comm1 As String
Set isect = Application.Intersect(Target, Range("C10:C14, C21:C47, F10:F14, F21:F47, I10:I14, I21:I47, L10:L14, L21:L47, O10:O14, O21:O47, r10:R14, r21:R47, U10:U14, U21:U47, X10:X14, X21:X47, AA10:AA14, AA21:AA47, AD10:AD14, AD21:AD47, AG10:AG14, AG21:AG47, AJ10:AJ14, AJ21:AJ47, AM10:AM14, AM21:AM47, AP10:AP14, AP21:AP47, AS10:AS14, AS21:AS47, AV10:AV14, AV21:AV47, AY10:AY14, AY21:AY47, BB10:BB14, BB21:BB47, BE10:BE14, BE21:BE47, BH10:BH14, BH21:BH47, BK10:BK14, BK21:BK47, BN10:BN14, BN21:BN47, BQ10:BQ14, BQ21:BQ47, BT10:BT14, BT21:BT47, BW10:BW14, BW21:BW47, BZ10:BZ14, BZ21:BZ47, CC10:CC14, CC21:CC47, CF10:CF14, CF21:CF47, CI10:CI14, CI21:CI47, CL10:CL14, CL21:CL47, CO10:CO14, CO21:CO47, CR10:CR14, CR21:CR47, CU10:CU14, CU21:CU47, CX10:CX14, CX21:CX47, DA10:DA14, DA21:DA47, DA10:DA14, DA21:DA47, DD10:DD14, DD21:DD47, DG10:DG14, DG21:DG47, DJ10:DJ14, DJ21:DJ47, DM10:DM14, DM21:DM47, DP10:DP14, DP21:DP47, DS10:DS14, DS21:DS47, DV10:DV14, DV21:DV47, DY10:DY14, DY21:DY47, EB10:EB14, EB21:EB47, EE10:EE14, EE21:
EE47 , EH10: EH14 , EH21: EH47 , EK10: EK14 , EK21: EK47 , EN10: EN14 , EN21: EN47 , EQ10: EQ14 , EQ21: EQ47 , ET10: ET14 , ET21: ET47 "))"
If isect Is Nothing Then
Else
If Target.Value = "No" Then
com = "Enter comment in " & Target.Offset(0, 1).Address(RowAbsolute:=False, columnabsolute:=False)
Do While comm1 = ""
comm1 = Application.InputBox(prompt:=com, Type:=2)
On Error GoTo myloop
If comm1 = False Then
comm1 = ""
End If
myloop:
On Error GoTo -1
Loop
Target.Offset(0, 1).Value = comm1
Else
Target.Offset(0, 1).Value = ""
End If
End If
End Sub


There are a few ways to skin this cat.
The easiest but least sustainable way to do what you're doing is to simply break up the line across rows.
Dim strRange As String
strRange = "C10:C14, C21:C47, F10:F14, F21:F47, I10:I14, I21:I47, L10:L14, L21:L47, O10:O14, O21:O47, r10:R14, r21:R47, U10:U14, U21:U47, X10:X14"
strRange = strRange & ", X21:X47, AA10:AA14, AA21:AA47, AD10:AD14, AD21:AD47, AG10:AG14, AG21:AG47, AJ10:AJ14, AJ21:AJ47, AM10:AM14, AM21:AM47, AP10:AP14"
strRange = strRange & ", AP21:AP47, AS10:AS14, AS21:AS47, AV10:AV14, AV21:AV47, AY10:AY14, AY21:AY47, BB10:BB14, BB21:BB47, BE10:BE14, BE21:BE47"
strRange= strRange & ... etc.
set isect = Application.Intersect(Target, Range(strRange))
... or you could create a named range within your workbook with all of those cells contained within it and then simply reference that in your code.
It keeps the maintenance of the range and the code separate, might not be for you though.
set isect = Application.Intersect(Target, Range("ValidateRange"))
Another way, looking at your cells, is to create an array and a loop (which could be enhanced to be even better) so that it's building the string up with an element of dynamicness.
Dim strRange As String, arrColumns(), i As Long, strCol As String
arrColumns = Array("C", "F", "I", "L", etc ...)
For i = 0 To UBound(arrColumns)
If i > 0 Then strRange = strRange & ","
strCol = arrColumns(i)
strRange = strRange & strCol & "10:" & strCol & "14," & strCol & "21:" & strCol & "47"
Next
Set isect = Application.Intersect(Target, Range(strRange))
Like I said, there are a few ways to do what you're wanting to do. If you're not wanting anything too complicated then go for the first solution.
I hope it helps.

Related

excel data validation multiple selection within the same celle separated by comma

I have an excel spreadsheet where I need to insert a data validation from a list, so far not a problem but I need to be able to select multiple entries without overwriting the previous as the normal data validation so the final result would be this:
List
Data Validation Result
Mango
Apple, Mango, Pixel
Iphone
Pixel, Apple
Pixel
Apple
Apple, Mango
Mango
Apple, Mango, Pixel
Iphone
Pixel, Apple
Pixel
I have found online a VBA code to insert in my spreadsheet to obatin the multiple selection without repetion:
Private Sub Worksheet_Change(ByVal Target As Range)
'UpdatebyExtendoffice20180510
Dim I As Integer
Dim xRgVal As Range
Dim xStrNew As String
Dim xStrOld As String
Dim xFlag As Boolean
Dim xArr
On Error Resume Next
Set xRgVal = Cells.SpecialCells(xlCellTypeAllValidation)
If (Target.Count > 1) Or (xRgVal Is Nothing) Then Exit Sub
If Intersect(Target, xRgVal) Is Nothing Then Exit Sub
Application.EnableEvents = False
xFlag = True
xStrNew = " " & Target.Value & ","
Application.Undo
xStrOld = Target.Value
If InStr(1, xStrOld, xStrNew) = 0 Then
xStrNew = xStrNew & xStrOld & ""
Else
xStrNew = xStrOld
End If
Target.Value = xStrNew
Application.EnableEvents = True
End Sub
It kinda works but I have 2 problems:
I can select multiple choices from my data but the result is this
List
Data Validation Result
Mango
Apple, Mango, Pixel,
with the final comma
I cannot delete or empty the field if I make the wrong selection, I need to use the Erase all function on that cell and then use the dropdown function to re-extend the data validation field from the empty cells not completed so far
I'm not familiar with VBA so any help is appreciated.
I mainly use R and SQL this is a task that I need to do for another person in my office that is going to use this spreadsheet and need to use this function with the lowest difficulty.
Any suggestions?

I have modified the code to add the space and comma only if it actually needs to join 2 strings together. So the first value does not have a comma attached until a second value is also selected.
I have also modified it to allow cells to be cleared. Pressing Delete will now properly allow the user to clear a cell.
Private Sub Worksheet_Change(ByVal Target As Range)
'UpdatebyExtendoffice20180510
Dim I As Integer
Dim xRgVal As Range
Dim xStrNew As String
Dim xStrOld As String
Dim xFlag As Boolean
Dim xArr
On Error Resume Next
Set xRgVal = Cells.SpecialCells(xlCellTypeAllValidation)
If (Target.Count > 1) Or (xRgVal Is Nothing) Then Exit Sub
If Intersect(Target, xRgVal) Is Nothing Then Exit Sub
Application.EnableEvents = False
xFlag = True
xStrNew = Target.Value
Application.Undo
xStrOld = Target.Value
If xStrNew <> "" Then
If InStr(1, xStrOld, xStrNew) = 0 Then
xStrNew = xStrNew & IIf(xStrOld <> "", ", " & xStrOld, "")
Else
xStrNew = xStrOld
End If
End If
Target.Value = xStrNew
Application.EnableEvents = True
End Sub
I left it, in-case it is being used in code that was not copied to this post, but xArr & I are declared but not used. xFlag is declared and set True but not used in any expression.

Assigning Macro with ParamArray: Formula is Too Complex to add to the Object

I have a macro (below) that inserts a new row into an un-defined number of Named ranges using ParamArray, it works fine except for when I try to assign the macro with more than 5-6 arguments I get a message box that says "Formula Too Complex to Assign To Object" (see picture above)
(see assignment string below)
'InsertNewRow "ServiceCrewDay_EmployeeList", "SAP_SCD_InPool", "SAP_SCD_OutPool", "SAP_SCD_SecondaryIn", "SAP_SCD_SecondaryOut", "SAP_SCD_ORD","SAP_SCD_THF","SAP_SCD_LH", "SAP_SCD_LH"'
Macro:
Sub InsertNewRow(ParamArray args() As Variant)
Dim ans: ans = MsgBox("WARNING: " & vbNewLine _
& "Action Cannot be undone!" & vbNewLine & "Continue?", vbYesNo, "Warning!")
If ans = vbNo Then: Exit Sub
Call HaltOperations
Call ActiveSheet.Unprotect()
Call Sheets("SAP Timesheet").Unprotect()
On Error GoTo OnError_Exit
'Loop and Check All Named Ranges Exist Before Proceeding
For Each a In args
If RangeExists(a) = False Then
MsgBox ("Named Range: " & a & " Not Defined!" & vbNewLine & "Operation Cancelled")
Exit Sub
End If
Next a
Dim rng As Range
'ADD ROW TO EACH NAMED INPUT RANGE
For Each a In args
Set rng = Range(a)
With rng
.Rows(.Rows.count).EntireRow.Insert
.Rows(.Rows.count - 2).EntireRow.Copy
.Rows(.Rows.count - 1).EntireRow.PasteSpecial (xlPasteFormulasAndNumberFormats)
On Error Resume Next: .Rows(.Rows.count - 1).EntireRow.PasteSpecial (xlPasteFormats)
End With
Next a
On Error GoTo OnError_Exit
'ADJUST HEIRACHY NUMBERS ON FIRST INPUT RANGE (MANNING TAB)
Set rng = Range(args(0))
Dim col As Integer
col = rng.Column
Cells(rng.Row + rng.Rows.count - 2, col).Offset(0, -1).Value _
= Cells(rng.Row + rng.Rows.count - 3, col).Offset(0, -1).Value + 1
Cells(rng.Row + rng.Rows.count - 1, col).Offset(0, -1).Value _
= Cells(rng.Row + rng.Rows.count - 3, col).Offset(0, -1).Value + 2
Call ResumeOperations
Application.CutCopyMode = False
Call ActiveSheet.Protect()
Call Sheets("SAP Timesheet").Protect()
Exit Sub
OnError_Exit:
Call ResumeOperations
Application.CutCopyMode = False
Call ActiveSheet.Protect()
Call Sheets("SAP Timesheet").Protect()
End Sub
Private Function RangeExists(rng As Variant) As Boolean
Dim Test As Range
On Error Resume Next
Set Test = Range(rng)
RangeExists = Err.Number = 0
End Function
Private Sub HaltOperations()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
End Sub
Private Sub ResumeOperations()
ResumeOps:
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub
The Macro itself runs as expected it's just the assigning the named ranges that is causing the issue.
is there a better way to do this?
or is there a way to get around the Formula is too complex method?
and if there is will that need to be done on all end user pc's or just on mine and the settings will carry over?
What I have thought about doing was just taking in 2 Named ranges and then for the following ranges Just offsetting those by the Row Count of the previous range so if Range2 = Sheets().Range("A1:A10") then Range3 = Range2.Offset(Range2.Rows.Count,0) then the assingment input would only need to be Range1 as string, Range2 as string, NumberOfExtraRanges as integer the reason I need atleast two ranges is because every range after range 1 is on a different tab and is essentially a raw data version of all pay info hours etc. in the first tab which will be Range1_EmployeeList
which I will play around with while I wait for a response.
TIA

Not a Complete answer but I did find that inside the ParamArray I could just assign One Input Range using a , to seperate each defined range. I haven't tested the limitations doing it this way but it does seem to atleast let me use a few extra inputs.
Example (Not Working):
Note: Each Defined Range is a Separate Input
'InsertNewRow "ServiceCrewDay_EmployeeList", "SAP_SCD_InPool" ," SAP_SCD_OutPool","SAP_SCD_SecondaryIn", "SAP_SCD_SecondaryOut"'
Example (Working):
Note Each Defined Range is passed as 1 input
'InsertNewRow "ServiceCrewDay_EmployeeList", "SAP_SCD_InPool, SAP_SCD_OutPool,SAP_SCD_SecondaryIn,SAP_SCD_SecondaryOut"'

Improving efficiency on background log routine

I created a log routine that creates a module in the desired file that records all changes for future auditing based on workbook events. I would like to com up with an alternative that I can activate at the start of a long process of routines applied to 100.000 rows, which mine doesn't seem to be able to support.
My log routine seems to work fine when activated in a blank worksheet, however it can't record all the changes made by my series of soubroutines. As it keeps track of each individual cell change in value and there are series of changes over the 100.000 rows, it crashes the application. I have been trying to think of a way to adapt it to be more efficient for my use, but so far I have been out of my depth.
Below is the code I import into the processed file to keep track of changes. If deemed necessary I can also post the routine that imports it.
public strOldAddress As String
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngSubTarget As Range
Dim lngBothCounter As Long
Dim Post() As String
'\ Parameters to register changes
Dim wsLog As Worksheet
Dim lngLogInputRow As Long
Set wsLog = ThisWorkbook.Sheets("Log")
'\ Detect changes in value
lngBothCounter = 1
ReDim Post(1 To Target.Cells.Count)
For Each rngSubTarget In Target.Cells
'\ Error Handler for changed values
If IsError(rngSubTarget.Value) Then
Post(lngBothCounter) = "ERROR"
Else
Post(lngBothCounter) = rngSubTarget.Value
End If
'\ Debug.Print for each value Ante and Post
'Debug.Print Post(lngBothCounter); " e " & Ante(lngBothCounter)
'\ Add changes values to log
If Ante(lngBothCounter) <> Post(lngBothCounter) Then
rngSubTarget.Interior.ColorIndex = 37
lngLogInputRow = wsLog.Range("A" & Rows.Count).End(xlUp).Row + 1
wsLog.Cells(lngLogInputRow, 1).Value = wsLog.Cells(lngLogInputRow, 1).Row - 1
wsLog.Cells(lngLogInputRow, 2).Value = Ante(lngBothCounter)
wsLog.Cells(lngLogInputRow, 3).Value = Post(lngBothCounter)
wsLog.Cells(lngLogInputRow, 4).Value = " " & rngSubTarget.Formula
wsLog.Hyperlinks.Add anchor:=wsLog.Cells(lngLogInputRow, 5), Address:="", _
SubAddress:="'" & ThisWorkbook.Sheets(1).Name & "'!" & rngSubTarget.Address, TextToDisplay:=rngSubTarget.Address
wsLog.Hyperlinks.Add anchor:=wsLog.Cells(lngLogInputRow, 6), Address:="", _
SubAddress:="'" & ThisWorkbook.Sheets(1).Name & "'!" & strOldAddress, TextToDisplay:=strOldAddress
wsLog.Cells(lngLogInputRow, 7).Value = Environ("username")
wsLog.Cells(lngLogInputRow, 8).Value = Now
End If
lngBothCounter = lngBothCounter + 1
Next rngSubTarget
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngSubTarget As Range
Dim lngAnteCounter As Long
lngAnteCounter = 1
ReDim Ante(1 To Target.Cells.Count)
For Each rngSubTarget In Target.Cells
'\ Error Handling for values in selection
If IsError(rngSubTarget.Value) Then
Ante(lngAnteCounter) = "ERROR"
Else
Ante(lngAnteCounter) = rngSubTarget.Value
End If
lngAnteCounter = lngAnteCounter + 1
Next rngSubTarget
strOldAddress = Target.Address
End Sub
I expected it to keep track of all changes but when too many modifications are made through a macro it crashes the application (the log file is blank until I try to save the file, when it crashes).

Worksheet ranges and line breaks

I am having trouble to populate a very large amount of specific cells with zeros. It seems that it only works if the block of cells A1:B1 is alone, as in Range("A1:B1"). Any help? Thank you in advance.
Sub zeroes()
Dim rng, t As Range
Dim z As Integer
z = 0
Sheets("Sheet1").Activate
Set rng = Range("A1:B1, C2:E2, F3:G3, H5:I5" _
& ",K11:M11, N1:O1, P6:Q6" _
& ",W4:Y4, Z7:AA7")
For Each t In rng
If t.Value = vbNullString Then t.Value = z
Next
End Sub
EDIT 1
Sub zeroes()
Dim rng As Range
Dim t as Range
Dim z As Integer
Sheets("Sheet1").Activate
Set t = Union([FO11:FR11], [FO26:FR26], [FO40:FR40], [FO54:FR54], [FO68:FR68], [FO82:FR82], [FO96:FR96], [FO110:FR110], [GE11:GH11], [GE26:GH26], [GE40:GH40], [GE54:GH54], [GE68:GH68], [GE82:GH82], [GE96:GH96], [GE110:GH110], [GU11:GX11], [GU26:GX26], [GU40:GX40], [GU54:GX54], [GU68:GX68], [GU82:GX82], [GU96:GX96], [GU110:GX110], _
[HK11:HN11], [HK26:HN26], [HK40:HN40], [HK54:HN54], [HK68:HN68], [HK82:HN82], [HK96:HN96], [HK110:HN110], [IA11:ID11], [IA26:ID26], [IA40:ID40], [IA54:ID54], [IA68:ID68], [IA82:ID82], [IA96:ID96], [IA110:ID110], [IQ11:IT11], [IQ26:IT26], [IQ40:IT40], [IQ54:IT54], [IQ68:IT68], [IQ82:IT82], [IQ96:IT96], [IQ110:IT110], _
[JG11:JJ11], [JG26:JJ26], [JG40:JJ40], [JG54:JJ54], [JG68:JJ68], [JG82:JJ82], [JG96:JJ96], [JG110:JJ110], [JW11:JZ11], [JW26:JZ26], [JW40:JZ40], [JW54:JZ54], [JW68:JZ68], [JW82:JZ82], [JW96:JZ96], [JW110:JZ110], [KM11:KP11], [KM26:KP26], [KM40:KP40], [KM54:KP54], [KM68:KP68], [KM82:KP82], [KM96:KP96], [KM110:KP110], _
[LC11:LF11], [LC26:LF26], [LC40:LF40], [LC54:LF54], [LC68:LF68], [LC82:LF82], [LC96:LF96], [LC110:LF110], [LS11:LV11], [LS26:LV26], [LS40:LV40], [LS54:LV54], [LS68:LV68], [LS82:LV82], [LS96:LV96], [LS110:LV110], [MI11:ML11], [MI26:ML26], [MI40:ML40], [MI54:ML54], [MI68:ML68], [MI82:ML82], [MI96:ML96], [MI110:ML110], _
[MY11:NB11], [MY26:NB26], [MY40:NB40], [MY54:NB54], [MY68:NB68], [MY82:NB82], [MY96:NB96], [MY110:NB110], [NO11:NR11], [NO26:NR26], [NO40:NR40], [NO54:NR54], [NO68:NR68], [NO82:NR82], [NO96:NR96], [NO110:NR110], [OE11:OH11], [OE26:OH26], [OE40:OH40], [OE54:OH54], [OE68:OH68], [OE82:OH82], [OE96:OH96], [OE110:OH110], _
[OU11:OX11], [OU26:OX26], [OU40:OX40], [OU54:OX54], [OU68:OX68], [OU82:OX82], [OU96:OX96], [OU110:OX110], [PK11:PN11], [PK26:PN26], [PK40:PN40], [PK54:PN54], [PK68:PN68], [PK82:PN82], [PK96:PN96], [PK110:PN110], [QA11:QD11], [QA26:QD26], [QA40:QD40], [QA54:QD54], [QA68:QD68], [QA82:QD82], [QA96:QD96], [QA110:QD110], _
[QQ11:QT11], [QQ26:QT26], [QQ40:QT40], [QQ54:QT54], [QQ68:QT68], [QQ82:QT82], [QQ96:QT96], [QQ110:QT110], [RG11:RJ11], [RG26:RJ26], [RG40:RJ40], [RG54:RJ54], [RG68:RJ68], [RG82:RJ82], [RG96:RJ96], [RG110:RJ110], [RW11:RZ11], [RW26:RZ26], [RW40:RZ40], [RW54:RZ54], [RW68:RZ68], [RW82:RZ82], [RW96:RZ96], [RW110:RZ110], _
[SM11:SP11], [SM26:SP26], [SM40:SP40], [SM54:SP54], [SM68:SP68], [SM82:SP82], [SM96:SP96], [SM110:SP110], [TC11:TF11], [TC26:TF26], [TC40:TF40], [TC54:TF54], [TC68:TF68], [TC82:TF82], [TC96:TF96], [TC110:TF110], [TS11:TV11], [TS26:TV26], [TS40:TV40], [TS54:TV54], [TS68:TV68], [TS82:TV82], [TS96:TV96], [TS110:TV110], _
[UI11:UL11], [UI26:UL26], [UI40:UL40], [UI54:UL54], [UI68:UL68], [UI82:UL82], [UI96:UL96], [UI110:UL110], [UY11:VB11], [UY26:VB26], [UY40:VB40], [UY54:VB54], [UY68:VB68], [UY82:VB82], [UY96:VB96], [UY110:VB110], [VO11:VR11], [VO26:VR26], [VO40:VR40], [VO54:VR54], [VO68:VR68], [VO82:VR82], [VO96:VR96], [VO110:VR110], _
[WE11:WH11], [WE26:WH26], [WE40:WH40], [WE54:WH54], [WE68:WH68], [WE82:WH82], [WE96:WH96], [WE110:WH110], [WU11:WX11], [WU26:WX26], [WU40:WX40], [WU54:WX54], [WU68:WX68], [WU82:WX82], [WU96:WX96], [WU110:WX110], [XK11:XN11], [XK26:XN26], [XK40:XN40], [XK54:XN54], [XK68:XN68], [XK82:XN82], [XK96:XN96], [XK110:XN110], _
[YA11:YD11], [YA26:YD26], [YA40:YD40], [YA54:YD54], [YA68:YD68], [YA82:YD82], [YA96:YD96], [YA110:YD110], [YQ11:YT11], [YQ26:YT26], [YQ40:YT40], [YQ54:YT54], [YQ68:YT68], [YQ82:YT82], [YQ96:YT96], [YQ110:YT110], [ZG11:ZJ11], [ZG26:ZJ26], [ZG40:ZJ40], [ZG54:ZJ54], [ZG68:ZJ68], [ZG82:ZJ82], [ZG96:ZJ96], [ZG110:ZJ110], _
[ZW11:ZZ11], [ZW26:ZZ26], [ZW40:ZZ40], [ZW54:ZZ54], [ZW68:ZZ68], [ZW82:ZZ82], [ZW96:ZZ96], [ZW110:ZZ110], [AAM11:AAP11], [AAM26:AAP26], [AAM40:AAP40], [AAM54:AAP54], [AAM68:AAP68], [AAM82:AAP82], [AAM96:AAP96], [AAM110:AAP110])
For Each t In rng
If t.Value = vbNullString Then t.Value = z
Next
End sub
And now the error ... "Wrong number of arguments or invalid property assignment"

Sub zeroes()
'need "As" for each declaration separated by comma.
'In "Dim rng, t As Range", rng will be declared as variant. But it wouldn't be a problem because it still works.
Dim rng As Range, t As Range
Dim z As Integer
z = 0
Sheets("Sheet1").Activate
'the syntax for Range() is Range(TopLeftCellAddress or FirstCellAddress, BottomRightCellAddress or LastCellAddress).
'note: [A1:B1] is just another way of writing Range("A1:B1")
Set rng = Union([A1:B1], [C2:E2], [F3:G3], [H5:I5], [K11:M11], [N1:O1], [P6:Q6], [W4:Y4], [Z7:AA7])
For Each t In rng
If t.Value = vbNullString Then t.Value = z
Next
End Sub
HTH
Lets introduce another function Intersect into the macro.
Sub Sample_Union_and_Intersect()
Dim wantedRows As Range
Dim wantedCols As Range
Dim rng As Range
Dim t As Range
Dim i As Variant
dim z as interger
z=0
'set initial wanted row
Set wantedRows = [11:11]
'Collect remaining wanted rows
For Each i In Array(26, 40, 54, 68, 82, 96, 110)
Set wantedRows = Union(wantedRows, Cells(i, 1).EntireRow)
Next i
Debug.Print wantedRows.Address
'set initial wanter column
Set wantedCols = [FO:FO]
'Collect remaining wanted columns
For Each i In Array("FR", "HK", "HN", "JG", "JJ")
Set wantedCols = Union(wantedCols, Cells(1, i).EntireColumn)
Next i
Debug.Print wantedCols.Address
'Intersect "wantedRows" and "wantedCols" to yield the wanted intersections.
Set rng = Intersect(wantedRows, wantedCols)
Debug.Print rng.Address
For Each t In rng
If t.Value = vbNullString Then t.Value = z
Next
End Sub
FYI, debug.print prints out debug message in the "Immediate" window. If you don't see the Immediate window, just press Ctrl+G and the window will turn on.

Range constraint and variable management when passing information from macro to userform to worksheet

I've built a userform that allows modification of a macro-generated string before it becomes part of a new spreadsheet. As written, I have one worry about how resilient it will be.
The form has a single textbox called CourseDescription into which a string value strBundleDescription is dumped:
frmDescriptionReview.CourseDescription = strBundleDescription
frmDescriptionReview.CourseDescription.MultiLine = True
frmDescriptionReview.CourseDescription.WordWrap = True
frmDescriptionReview.Show
The user can then edit the text as needed and press OK to pass the text to the spreadsheet being created.
On clicking OK, the modified string is placed in Range("B7") of the spreadsheet:
Private Sub cmdOK_Click()
Dim strValue As String
strValue = CourseDescription.Value
If strValue <> "" Then
Range("B7").Value = strValue
End If
Unload Me
End Sub
This works so far in practice, but I've had unexplained focus issues before. I am concerned that the focus might in some (unknown) circumstance shift to another open worksheet and the text will be pasted where it does not belong.
My question: Am I right to want a more defined location, or will a simple range definition like the one above be adequate? And if a more defined location is advised, is there a way to pass information like the wkbSaba and shtCourse values without making public variables?
All potential solutions I found involved some form of public variable, but on principle (rightly or wrongly) I'm trying to avoid public variables when information will only be used in one function (as in this case).
Full Code, as requested: This is the the full macro code as it stands. The call for frmDescriptionReview is about 3/4 of the way down under the comment tag "'enter base information for Bundle Description".
I'm going to try the Property call as you suggest, which is something I did not know about, and had not seen when web searching for ways to pass data to a userform. So much to learn! It certainly looks like the variables could be passed that way.
Option Explicit
Sub TransferData()
'***************************************
' TO USE THIS MACRO:
' 1. Make sure that all information for the bundle is included
' on the 'km notification plan' and 'bundle details (kbar)' tabs
' of the Reporting_KMFramework.xlsx
' 2. Select the bundle name on the 'km notification plan' tab.
' 3. Start the macro and it should create the basis of the Saba
' form
' 4. Read through the entire form, especially the bundle
' description, to be sure it is complete and accurate.
'***************************************
'establish variables
Dim iRow As Integer
Dim sTxt As String
Dim sTxt2 As String
Dim sBundleName As String
Dim sNumber As String
Dim aSplit() As String
Dim aSplit2() As String
Dim aBundleSplit() As String
Dim aNumberSplit() As String
Dim wkbFramework As Workbook
Dim wkbSaba As Workbook
Dim shtPlan As Worksheet
Dim shtCourse As Worksheet
Dim vData As Variant
Dim vBundleName As Variant
Dim lLoop As Long
'set initial values for variables
'find current row number
iRow = ActiveCell.Row
'remember locations of current data
Set wkbFramework = ActiveWorkbook
Set shtPlan = ActiveSheet
'Set rngSelect = Range("B" & iRow)
'select bundle name
vBundleName = shtPlan.Range("B" & iRow).Value
vData = vBundleName
sBundleName = shtPlan.Range("B" & iRow).Value
'find and save course names for the bundle
Sheets(2).Select
sTxt = Find_Range(vBundleName, Columns("B"), xlValues).Offset(0, 1).Value 'course names from Detail tab
sTxt2 = Find_Range(vBundleName, Columns("B"), xlValues).Offset(0, 2).Value 'course numbers from Detail tab
'open new Saba Form
Workbooks.Add Template:= _
"C:\Documents and Settings\rookek\Application Data\Microsoft\Templates\Bundle_SabaEntryForm_KM.xltm"
'remember locations of Saba form
Set wkbSaba = ActiveWorkbook
Set shtCourse = ActiveSheet
'move data into new Saba form
'paste bundle name
wkbSaba.Sheets(shtCourse.Name).Range("B5").Value = vData
'Transfer bundle number
vData = wkbFramework.Sheets(shtPlan.Name).Range("E" & iRow).Value
sNumber = vData
Dim aNumber() As String
aNumber = Split(sNumber, "-")
wkbSaba.Sheets(shtCourse.Name).Range("B6").Value = vData
'create names to use in the bundle description and (later) in naming the file
'Establish additional variables
Dim strDate As String
Dim strName1 As String
Dim strName2 As String
Dim strName3 As String
Dim strName4 As String
Dim strName5 As String
Dim aTechSplit() As String
Dim aCourse() As String
Dim iTech As Integer
'Dim iBundle As Integer
Dim iCourse As Integer
vData = wkbFramework.Sheets(shtPlan.Name).Range("L" & iRow).Value
aCourse = Split(sTxt, Chr(10))
iCourse = UBound(aCourse)
aTechSplit = Split(vData, " ")
iTech = UBound(aTechSplit)
aBundleSplit = Split(sBundleName, " ")
aNumberSplit = Split(sNumber, "-")
strName1 = aBundleSplit(0)
strName2 = aBundleSplit(1)
If UBound(aNumberSplit) > 1 Then
strName3 = aNumberSplit(UBound(aNumberSplit) - 1) & aNumberSplit(UBound(aNumberSplit))
End If
strName3 = Right(strName3, Len(strName3) - 1)
strName4 = aTechSplit(0) & " "
strName5 = aCourse(0)
For lLoop = 1 To iTech - 1
strName4 = strName4 & aTechSplit(lLoop) & " "
Next lLoop
If iCourse > 1 Then
For lLoop = 1 To iCourse - 1
strName5 = strName5 & ", " & aCourse(lLoop)
Next lLoop
strName5 = strName5 & ", and " & aCourse(iCourse)
End If
If iCourse = 1 Then
strName5 = strName5 & ", and " & aCourse(iCourse)
End If
strName5 = Replace(strName5, " Technical Differences", "")
strName5 = Replace(strName5, " Overview", "")
strName5 = Replace(strName5, " Technical Presales for ATCs", "")
strName5 = Replace(strName5, " Technical Presales for STCs", "")
strName5 = Replace(strName5, " Technical Presales", "")
'enter base information for Bundle Description
Dim strBundleDescription As String
strBundleDescription = "This Knowledge Maintenance bundle covers recent technology changes that may affect " & strName4 & "environments. Topics covered by this bundle include the enhancements and features introduced with " & strName5 & "."
'wkbSaba.Sheets(shtCourse.Name).Range("B7").Value = strBundleDescription
frmDescriptionReview.CourseDescription = strBundleDescription
frmDescriptionReview.CourseDescription.MultiLine = True
frmDescriptionReview.CourseDescription.WordWrap = True
frmDescriptionReview.Show
'transfer tech and track
wkbSaba.Sheets(shtCourse.Name).Range("B8").Value = vData
'transfer product GA date
vData = wkbFramework.Sheets(shtPlan.Name).Range("G" & iRow).Value
wkbSaba.Sheets(shtCourse.Name).Range("B9").Value = vData
'transfer bundle notification date
vData = wkbFramework.Sheets(shtPlan.Name).Range("D" & iRow).Value
wkbSaba.Sheets(shtCourse.Name).Range("B10").Value = vData
'set audience type
If aNumber(UBound(aNumber)) = "SA" Then
wkbSaba.Sheets(shtCourse.Name).Range("B11").Value = "Internal, Partner, Customer"
Else
wkbSaba.Sheets(shtCourse.Name).Range("B11").Value = "Internal, Partner"
End If
'set Education Manager
frmEducationManagerEntry.EducationManagers.MultiLine = True
frmEducationManagerEntry.EducationManagers.WordWrap = True
frmEducationManagerEntry.Show
'set EPG
wkbSaba.Sheets(shtCourse.Name).Range("B13").Value = "N/A (KM course reuse)"
'set Test information to N/A
wkbSaba.Sheets(shtCourse.Name).Range("A22:B22").Value = "N/A"
'enter course names
aSplit = Split(sTxt, Chr(10)) 'if there is more than one course, this establishes a number and location for each
If UBound(aSplit) > 4 Then
'add rows equal to the difference between ubound and 5
wkbSaba.Sheets(shtCourse.Name).Range("A21", "B" & 21 + (UBound(aSplit) - 5)).Select
Selection.EntireRow.Insert
End If
For lLoop = 0 To UBound(aSplit)
wkbSaba.Sheets(shtCourse.Name).Range("B" & 17 + lLoop).Value = aSplit(lLoop)
Next lLoop
'enter course numbers
aSplit2 = Split(sTxt2, Chr(10)) 'if there is more than one course, this establishes a number and location for each
For lLoop = 0 To UBound(aSplit2)
wkbSaba.Sheets(shtCourse.Name).Range("A" & 17 + lLoop).Value = Trim(aSplit2(lLoop))
Next lLoop
'save and close Saba form
With wkbSaba.Sheets(shtCourse.Name)
Dim SaveAsDialog As FileDialog
strDate = Date
strDate = Replace(strDate, "/", ".")
Set SaveAsDialog = Application.FileDialog(msoFileDialogSaveAs)
With SaveAsDialog
.Title = "Choose a file location and file name for your new Saba form"
.AllowMultiSelect = False
.InitialFileName = strName1 & strName2 & "_SabaEntryForm_" & strName3 & ".xlsx"
'.InitialFileName = sSavelocation & "\" & strName3 & "\" & aBundleSplit(0) & aBundleSplit(1) & "_" & strName3 & "_SabaEntryForm" & ".xlsx"
.Show
.Execute
End With
wkbSaba.Sheets(shtCourse.Name).PrintOut
wkbSaba.Close
End With
' Return focus to Plan sheet
shtPlan.Activate
End Sub
Addition of Property code fails
I tried adding code based on the property link shared in the comments, but running the code results in a Compile error: Method or data member not found. The complete userform code looks like this:
Option Explicit
Private wkbLocation As Workbook
Private shtLocation As Worksheet
Private Sub cmdCancel_Click()
Unload Me
End
End Sub
Private Sub cmdOK_Click()
Dim strValue As String
strValue = CourseDescription.Value
If strValue <> "" Then
wkbLocation.Sheets(shtLocation).Range("B7").Value = strValue
End If
Unload Me
End Sub
Property Let MyProp(wkbSaba As Workbook, shtCourse As Worksheet)
wkbLocation = wkbSaba
shtLocation = shtCourse
End Property
And the call for the userform now looks like this:
'enter base information for Bundle Description
Dim strBundleDescription As String
strBundleDescription = "This Knowledge Maintenance bundle covers recent technology changes that may affect " & strName4 & "environments. Topics covered by this bundle include the enhancements and features introduced with " & strName5 & "."
'wkbSaba.Sheets(shtCourse.Name).Range("B7").Value = strBundleDescription
Dim frmDescriptionReview As UserForm3
Set frmDescriptionReview = New UserForm3
frmDescriptionReview.MyProp = "Pass to form"
frmDescriptionReview.CourseDescription = strBundleDescription
frmDescriptionReview.CourseDescription.MultiLine = True
frmDescriptionReview.CourseDescription.WordWrap = True
frmDescriptionReview.Show
When I run the code, I get a Compile error: Method or data member not found, highlighting .MyProp. Help says this error means I misspelled the object or member name, or specified a collection index that is out of range. I checked the spelling, and MyProp is exactly how I spelled it in both locations. I don't think I'm specifying a collection am I? None are explicitly defined. What am i doing wrong?

I am concerned that the focus might in some (unknown) circumstance
shift to another open worksheet and the text will be pasted where it
does not belong.
Not really sure what you are asking. But you can further define your range variable by using:
Workbooks("Book1.xlsm").Worksheets("Sheet1").Range("B7").Value = strValue
or
Workbooks(wkbSaba).Worksheets(shtCourse).Range("B7").Value = strValue
That will ensure it goes to the right workbook and worksheet. I'm not sure why you think you need public variables?
EDIT:
UserForm Code:
Private wsSheet As Worksheet
Property Let SetWorksheet(wsSheetPass As Worksheet)
Set wsSheet = wsSheetPass
End Property
Private Sub cmdOK_Click()
Dim strValue As String
strValue = CourseDescription.Value
If strValue <> "" Then
wsSheet.Range("B7").Value = strValue
End If
Unload Me
End Sub
Calling Module:
Dim wsSheetToPass As Worksheet
Set wsSheetToPass = Workbooks(wkbSaba).Worksheets(shtCourse)
frmDescriptionReview.SetWorksheet = wsSheetToPass

As Reafidy states, creating a Property for the Userform and passing information to it would clearly be the right answer for passing variables to and from a userform.
Ideally what I want is to have the form very losely coupled with the module, and not touch the spreadsheet at all (so when appropriate I can pass information to the form from other modules, get the information returned, and place it where appropriate for the current module (which could be on an entirely different spreadsheet or in a completely different cell).
I found additional information on passing data with properties on the PeltierTech web site (http://peltiertech.com/Excel/PropertyProcedures.html) that helped me understand what Reafidy was doing so I couls start loosening the coupling between my code and my forms even more (which was my original intent for this question.
Adding the Get property allows the loose coupling I'm looking for, allowing me to both give and receive information without having to pass the spreadsheet data at all. So my call in the module now looks like this:
'review and revise Description Text
Dim DescriptionReview As New frmDescriptionReview
With DescriptionReview
.Description = strBundleDescription
.Show
strBundleDescription = .Description
End With
Unload DescriptionReview
'transfer description text
wkbSaba.Sheets(shtCourse.Name).Range("B7").Value = strBundleDescription
and the code for the UserForm itself becomes much simpler, like this:
Option Explicit
Property Let Description(ByVal TextBeingPassed As String)
Me.CourseDescription.Value = TextBeingPassed
End Property
Property Get Description() As String
Description = Me.CourseDescription.Value
End Property
Private Sub cmdOK_Click()
Me.Hide
End Sub
Private Sub cmdCancel_Click()
Unload Me
End
End Sub

Resources