Worksheet ranges and line breaks - excel
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.
Related
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"'
Excel VBA - Range(Find().Adress).Row
I have googled and struggled with this for hours now.
I have a Control workbook, that pulls data from a varied amount of other workbooks (the Control workbook also creates the other workbooks and saves the names and dir of said workbooks so that they can be called later)
This piece of code is the problem.
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Declare_Sheets
Dim SearchresultROW
Dim Searchresult As String
Dim complexrow As Integer
Dim CurrSheet As Worksheet
Dim Stype As String
Dim startROW As Integer
Dim endROW As Integer, SearchCOL As Integer, OffROW As Integer
Dim PDATArange As Range, CDATArange As Range
Dim Dateyear, Datemonth, datetest As String
Stype = WSRD.Range("B11")
'Find complex to work with
complexrow = WSSS.Range("F7")
WSSS.Activate
SearchresultROW = Range(Cells(7, 15), Cells(complexrow, 15).Find(Callsheet).Address).Row
Searchresult = WSSS.Cells(SearchresultROW, 15).Offset(0, 1)
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
The below code is the problem extract
complexrow = WSSS.Range("F7")
WSSS.Activate
SearchresultROW = Range(Cells(7, 15), Cells(complexrow, 15).Find(Callsheet).Address).Row
Searchresult = WSSS.Cells(SearchresultROW, 15).Offset(0, 1)
1st problem
I cant get the find() to work without activating worksheet - WSSS
Declare_Sheets gets run at the start which declares WSSS, this works everywhere else in my code, but not with this find().
2nd problem
The code below compiles and finishes, BUT - It does not return the correct data.
This code calls starts the macro
Cancel = True
Dim Calsheet As String
If Target.Column <> 1 Then Exit Sub
Calsheet = Target.Value
Call Call_Readings(Calsheet)
End Sub
There are currently 2 possibilities
I double click on Casper Tcomp 4.
Callsheet = "Casper Tcomp 4" - Which is correct (target of the double click)
Complexrow = "9" - Which is correct (this will increment as new sheets are added)
SearchresultROW = "7" - This is wrong, it should be 8
I have tried adding LookAt:=xlWhole and LookIn:-xlValues, doesnt change a thing
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Declare_Sheets
Dim SearchresultROW
Dim Searchresult As String
Dim complexrow As Integer
Dim CurrSheet As Worksheet
Dim Stype As String
Dim FindResult As Range
Dim startROW As Integer
Dim endROW As Integer, SearchCOL As Integer, OffROW As Integer
Dim PDATArange As Range, CDATArange As Range
Dim Dateyear, Datemonth, datetest As String
Stype = WSRD.Range("B11")
'Find complex to work with
complexrow = WSSS.Range("F7")
On Error Resume Next 'next line will error if nothing is found
Set FindResult = WSSS.Range(WSSS.Cells(7, 15), WSSS.Cells(complexrow, 15)).Find(What:=Callsheet, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchByte:=False)
On Error GoTo 0 'always re-activate error reporting!
If Not FindResult Is Nothing Then 'check if find was successful
SearchresultROW = FindResult.Row
Searchresult = WSSS.Cells(SearchresultROW, 15).Offset(0, 1)
Else 'if nothing was found show message
MsgBox "NO WB FOUND.", vbCritical
End If
This solved the problem, thanks for the assistance Pᴇʜ
Your code without .Activate would look something like below. Note that every Range, Cells, Rows or Columns object needs to be referenced with the correct Workbook/Worksheet:
complexrow = WSSS.Range("F7")
'try to find something
Dim FindResult As Range
On Error Resume Next 'next line will error if nothing is found
Set FindResult = WSSS.Cells(complexrow, 15).Find(What:=Callsheet, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchByte:=False)
On Error GoTo 0 'always re-activate error reporting!
If Not FindResult Is Nothing Then 'check if find was successful
SearchresultROW = WSSS.Range(WSSS.Cells(7, 15), FindResult).Row
Searchresult = WSSS.Cells(SearchresultROW, 15).Offset(0, 1)
Else 'if nothing was found show message
MsgBox "nothing found.", vbCritical
End If
Note that if using the Range.Find method you need to check if something was found before you can use the result of Find. Otherwise it will throw an error. Also note that the documentation of Find says that …
The settings for LookIn, LookAt, SearchOrder, and MatchByte are saved each time you use this method.
So if you don't define them each time using Find it will use whatever was used last by either VBA or the user interface. Since you have no control about what was used last by the user interface I highly recomment to define them everytime using Find or you will get random results.
Also note that Callsheet is not defined in your code yet, so check that.
Excel VBA: `range.find()` does not find values which are displayed as `####`
I'm trying to find a specific value in a specific column. For example the value 100000 in the column B. The following code only works if the column is wide enough to display the full number: Dim rngSearchRange As Range Set rngSearchRange = ThisWorkbook.Worksheets(1).Columns(2) Dim searchTerm As Variant searchTerm = 100000 Dim rngResultRange As Range Set rngResultRange = rngSearchRange.Find(What:=searchTerm, lookin:=xlValues, lookat:=xlWhole) As soon as the column gets to narrow, so Excel only displays ##### instead of 100000 in the specific cell the find-method returns Nothing. Is there a way to use the find-method based on the actual values and not on the display of the values? If not, are there any alternatives to For Each cell In rng.Cells? Eventually, I'm looing the method which usees up the least resources. Note: the searchRange is only one column, the searchValue either doesn't exist or only exists once. Note: there is a followup question on using match() Note: from time to time it seems to work although neither data nor code changes. Unfortunately, I can not reproduce the change. This whole thing might be a bug indeed
Can reproduce the Find failing if the column width is too narrow. Match doesn't have this problem. Sub dural() Dim rngSearchRange As Range Set rngSearchRange = ThisWorkbook.Worksheets(1).Columns(2) Dim searchTerm As Variant searchTerm = 100000 Dim rngResultRange As Range Dim found As Variant found = Application.Match(searchTerm, rngSearchRange, 0) If Not IsError(found) Then Set rngResultRange = rngSearchRange.Cells(found) MsgBox rngResultRange.Address End If End Sub Depending on your use case, this may be an option, or if not, maybe Range.AutoFit? Though with "I'm trying to find a specific value in a specific column," it sounds like this could be an option.
You could either get the range into an array and loop the array, or just use MATCH: Sub test() Dim rngSearchRange, rngResultRange As Range Dim searchTerm As Variant Dim vRow As Variant Set rngSearchRange = ThisWorkbook.Worksheets(1).Columns(2) searchTerm = 10000 vRow = Application.Match(searchTerm, rngSearchRange, 0) If Not IsError(vRow) Then Set rngResultRange = rngSearchRange.Resize(1, 1).Offset(vRow - 1, 0) Else MsgBox "Not Found" End If End Sub
Try this: Sub test() Dim rngSearchRange, rngResultRange As Range Dim searchTerm As Variant Set rngSearchRange = ThisWorkbook.Worksheets(1).Columns(2) searchTerm = 10000 Set rngResultRange = rngSearchRange.Find(what:=searchTerm, LookIn:=xlValues) End Sub
The issue with find is that it only looks for displayed values for some reason, identical to the behaviour of the search box you get pressing crtl+F or clicking the "Find & Select" option on your "Home" ribbon. There is currently no known way to fix this (looking in xlValues and the like as the comments pointed out)
As there are various ways to get around this, the (slowest) but most reliable one would be to use a foreach loop as so:
For Each cel In rngSearchRange
If cel.Value = searchTerm Then
Set rngResultRange = cel
exit for '<-If you want the first result, leave this. If you want the last result, omit. Using the first result could be significantly quicker as it will stop looping right away.
End If
Next cel
Just make sure you set your range as definite value like Range("A1:B87") instead of Columns(2) as this will throw a type mismatch error. If you want to search column B, use Range("B:B") instead.
This is a cheating-version: It will copy the range to a temporary Worksheet, converting Formulas to Values, and do the lookup there. Public Function FindValueInRange(ByVal RangeToSearch As Range, ByVal ValueToFind As Variant) As Range Dim WasActive As Worksheet, ScreenUpdating As Boolean, Calculation As XlCalculation 'Store current position Set WasActive = ActiveSheet ScreenUpdating = Application.ScreenUpdating Application.ScreenUpdating = False Calculation = Application.Calculation Application.Calculation = xlCalculationManual 'Let's get to work! Set FindValueInRange = Nothing 'Default to Nothing On Error GoTo FunctionError Dim TempSheet As Worksheet, FoundCell As Range, DisplayAlerts As Boolean 'Create Temp Sheet Set TempSheet = Worksheets.Add 'Copy data to Temp Sheet, in the same location TempSheet.Range(RangeToSearch.Address(True, True, xlA1, False)).Value = RangeToSearch.Value 'Column Width to Maximum! TempSheet.Range(RangeToSearch.Address(True, True, xlA1, False)).EntireColumn.ColumnWidth = 255 'Search the cells in the Temp Sheet Set FoundCell = TempSheet.Range(RangeToSearch.Address(True, True, xlA1, False)).Find(ValueToFind, LookIn:=xlFormulas, LookAt:=xlWhole) 'Return the found cell, but on the original Worksheet If Not (FoundCell Is Nothing) Then Set FindValueInRange = RangeToSearch.Worksheet.Range(FoundCell.Address(True, True, xlA1, False)) 'Remove the Temp Sheet DisplayAlerts = Application.DisplayAlerts Application.DisplayAlerts = False TempSheet.Delete Application.DisplayAlerts = DisplayAlerts Set TempSheet = Nothing FunctionError: On Error GoTo -1 'Reset the error buffer 'Restore previous position WasActive.Activate Application.Calculation = Calculation Application.ScreenUpdating = ScreenUpdating End Function This would then be used like so: Set rngResultRange = FindValueInRange(rngSearchRange, searchTerm)
Set Intersect line for multiple ranges is too long
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.
Sum using Index vba excel
Can someone tell me the correct syntax for this code I am trying to execute? From a 1D range of string values, I want to pick a certain string say "this" and calculate the sum of all the values of "this" which are displayed in the immediate next column. It's been eating my head up for hours. And also, is there another better way to do it?
With Application.WorksheetFunction
Range("AA2").Value = .Sum(.Index(ws(1).Range("F8"), .Match(ws(1).Range("AA1"), ws(1).Range("E8:E16"), 0), 0) **:** .index(ws(1).Range("F16"), .Match(ws(1).Range("AA1"), ws(1).Range("E8:E16"), 0), 0)
End With
In excel it would be:
=SUMIF(E8:E16,"=this",F8:F16)
So in your macro try:
Option Explicit
Public Sub StackOverflowDemo()
Dim conditionText As String
Dim ws As Worksheet
Dim target As Range
Dim sourceCriteria As Range
Dim sourceSum As Range
Set ws = ThisWorkbook.Sheets(1)
conditionText = "this"
Set target = ws.Range("AA2")
Set sourceCriteria = ws.Range("E8:E16")
'the above stuff would probably be passed as parameters since I doubt you want that stuff hard coded
'from here on there's no hard coding.
Set sourceSum = sourceCriteria.Offset(0, 1)
target.Value = WorksheetFunction.SumIf(sourceCriteria, "=" & conditionText, sourceSum)
End Sub
Update: Refactored to show the reusability / benefit of using variables:
Option Explicit
Public Sub StackOverflowDemo()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(1)
DoSumIf ws.Range("E8:E16"), "this", ws.Range("AA2")
DoSumIf ws.Range("E8:E16"), "that", ws.Range("AA3")
DoSumIf ws.Range("B2:B32"), "who", ws.Range("AA4")
End Sub
Private Sub DoSumIf(sourceCriteria As Range, conditionText As String, target As Range)
Dim sourceSum As Range
Set sourceSum = sourceCriteria.Offset(0, 1)
target.Value = WorksheetFunction.SumIf(sourceCriteria, "=" & conditionText, sourceSum)
End Sub
You can do it in VBA using something to this effect:
This will search E2:E300 for the string "P09" and sum the column directly to the right.
Sub Test123455()
Dim MyRange As Range
Set MyRange = Nothing
Dim curcell As Range
For Each curcell In Range("E2:E300")
If InStr(1, curcell.Value, "P09", vbTextCompare) > 0 Then
If MyRange Is Nothing Then
Set MyRange = curcell
Else
Set MyRange = Union(MyRange, curcell.Offset(0, 1))
End If
End If
Next curcell
MsgBox Application.WorksheetFunction.Sum(MyRange)
End Sub