How to Make Range Dynamic in VBA - excel

Below, I have code that sends a personalized SMS message and includes the name. I got that part to work. Now, I just need to make it so that my range is dynamic and moves down the respective column until there is no one left to message. In it's current state, it will only message the first person. I tried looking up dynamic range tutorials, loops, etc. but they were either too complex for me to grasp or would require me to rewrite what I already have working.
Private Sub btnSend_Click()
Dim contactNumberRange As Range
Dim messageRange As Range
Dim clientNameRange As Range
Dim phoneCell As Range
Dim messageCell As Range
Dim nameCell As Range
Set contactNumberRange = Range("D2") //Need to make this range dynamic
Set messageRange = Range("E2") //This too
Set clientNameRange = Range("A2") //This aswell
For Each phoneCell In contactNumberRange
For Each messageCell In messageRange
For Each nameCell In clientNameRange
SendMessage FROMPHONE, nameCell.Value, phoneCell.Value, messageCell.Value
Next
Next
Next
Me.Hide
End Sub

You just need to ammend your ranges with a last row variable.
Also, qualify those ranges with a worksheet!
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim LR As Long
LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
Set contactNumberRange = ws.Range("D2:D" & LR)
Set messageRange = ws.Range("E2:E" & LR)
Set clientNameRange = ws.Range("A2:A" & LR)
For Each phoneCell In contactNumberRange
For Each messageCell In messageRange
For Each nameCell In clientNameRange
SendMessage FROMPHONE, nameCell.Value, phoneCell.Value, messageCell.Value
Next nameCell
Next messageCell
Next phoneCell

Related

SpecialCells Type Visible cannot find last row in vba

All, I am working part of my code where I want to update filtered noncontiguous cells with index / match. Core of my code is working in proper manner in another case but here seems wrong and do not know what is the reason behind. Working turn endless and could cause that no last row find in section here: Set rngI = usedR.Resize(usedR.Rows.Count - 1).Offset(5).Columns("I:I").SpecialCells(xlCellTypeVisible). Checked with debug.print the result which shows me the end as wrong...$I$174:$I$1046999...proper has to be $I$174:$I$197...what could be the reason behind?
Another question using lastrow calculation..on this way this doesnt work, Dim lastrow As Long, lastrow = rngD(Rows.Count, 1).End(xlUp).row I have to correct like this to count...lastrow = rngD(rngD.Rows.Count, 1).End(xlUp).row. What's the reason behind that once working on first way, once only if I double type range. This code is in Personal folder if it counts anyway
Sub Macro2()
Dim wbD As Workbook: Set wbD = Workbooks("dashboard-advanced.xls")
Dim wsD As Worksheet: Set wsD = wbD.Sheets("Sheet1")
Dim rngD As Range: Set rngD = wsD.Range("A:C")
Dim wbCallLCL As Workbook: Set wbCallLCL = Workbooks("CALL_REPORT.xlsx")
Dim wsCallLCL As Worksheet: Set wsCallLCL = wbCallLCL.Sheets("LCL")
Dim rngCallLCL As Range: Set rngCallLCL = wsCallLCL.Range("A:V")
rngCallLCL.autofilter Field:=10, Criteria1:=Blanks
Dim lastrow As Long
lastrow = rngD(rngD.Rows.Count, 1).End(xlUp).row
Dim usedR As Range, rngI As Range, A As Range, C As Range
Set usedR = wsCallLCL.UsedRange
Set rngI = usedR.Resize(usedR.Rows.Count - 5).Offset(1).Columns("I:I").SpecialCells(xlCellTypeVisible)
For Each A In rngI.Areas
For Each C In A.Cells
res = Application.Match(C.Value, wsD.Range("A2:" & "A" & lastrow), 0)
If IsError(res) Then
C.Offset(, 1).Value = ""
Else
C.Offset(, 1).Value = Application.WorksheetFunction.Index(wsD.Range("B2:" & "B" & lastrow), res, 0)
End If
Next C
Next A
End Sub

Merge Multiple Worksheets into a Single Worksheet in the Same Workbook

I currently have code for each sheet I want to move but I am wondering if there was a way to reduce this code.
This is what I currently use to move each sheet times 8 or so sheets:
For Each ws In ActiveWorkbook.Worksheets
If ws.Name = "ONI" Then
Set RNG1 = ONI.Range("A1:AK1").EntireColumn
Set RNG2 = All.Range("A1:AK1").EntireColumn
RNG2.Value = RNG1.Value
End If
Next
This is the code I use when I want to move a single column from all sheets to a single sheet. I can't figure out how to modify it to include more columns.
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "MainSheet" Then
Set RNG1 = ws.Range("A1:A700")
Set RNG2 = Sheets ("MainSheet") _
.Cells(Rows.Count,"A").End(xlUp).Offset(1)
RNG2.Value = RNG1.Value
End If
Next
So basically is it possible to modify this code to include multiple columns?
Kudos for going for the value transfer instead of copy/paste. You just need to resize your Rng2 to match the size of Rng1.
I also modified this to work with dynamic row counts. If you need to copy a static range for each sheet, you can get rid of the LR bits and hard code the range. You need to keep nLR as this determines the next available row on your main sheet.
Sub Test()
Dim ms As Worksheet: Set ms = ThisWorkbook.Sheets("MainSheet")
Dim ws As Worksheet, Rng1 As Range, Rng2 As Range
Dim LR As Long, nLR As Long '(LR = Last Row, nLR = New Last Row for Main Sheet)
For Each ws In Worksheets
If ws.Name <> ms.Name Then
'Determine Relavent Ranges (last rows)
LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
nLR = ms.Range("A" & ms.Rows.Count).End(xlUp).Offset(1).Row
'Set the ranges
Set Rng1 = ws.Range("A1:L" & LR)
Set Rng2 = ms.Range("A" & nLR).Resize(Rng1.Rows.Count, Rng1.Columns.Count)
'Value Transfer
Rng2.Value = Rng1.Value
End If
Next ws
End Sub
Think you need a nested loop here, long time since i wrote vba so i give pseudo code, hope this help you on the way.
for each ws
dim rang as Range
for Each rnge In Range("A1:H1").Columns
do something
next
next

excel vba: Range gives Argument Not Optional error message

In excel vba I'm tryin to select a range of values starting in Cell"O2", (O from Oyster) down to the end of the sheet,
I'm trying:
Range("O2", Range.End(xlDown))
But that fails with Argument Not Optional. What am i doing wrong?
I'm using Excel 2010.
Don't use xlDown Declare your Objects and then work with it.
Use this
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim LRow As Long
Dim rng As Range
'~~> Change this to the relevant sheet name
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
'~~> Find last row in Col O which has data
LRow = .Range("O" & .Rows.Count).End(xlUp).Row
'~~> This is your range
Set rng = .Range("O2:O" & LRow)
With rng
'~~> Whatever you want to do
End With
End With
End Sub
To select the range from O2 to the last filled cell in that column, you could use:
Range("O2", Range("O2").End(xlDown)).Select
But that has a few problems, including the fact that it will "stop" at any blanks, and that you should avoid using Select unless absolutely necessary. Also, you should get in the habit of qualifying your ranges, e.g., specifying which worksheet they're in. Given all that, I propose something like this, assuming you wanted to turn the cells in the range red:
Sub test()
Dim LastRow As Long
Dim ws As Excel.Worksheet
Set ws = ActiveSheet
With ws
LastRow = .Range("O" & .Rows.Count).End(xlUp).Row
.Range("O2:O" & LastRow).Interior.Color = vbRed
End With
End Sub
Maybe you need
Range("O2", Range("O2").End(xlDown)).Select
?

VBA Excel: modify dynamic named range code

Newbie question: I have module, originally made by Roger Govier.
It uses an input cell header and creates a dynamic named range for the non empty cells positioned under header. The created named range will be labeled as the value of the header cell.
Private Sub CreateNamedRange(header As range)
Dim wb As Workbook
Dim WS As Worksheet
Dim rStartCell As range
Dim rData As range
Dim rCol As range
Dim lCol As Long
Dim sSheet As String
Dim Rowno As Long
' get table location
Set rStartCell = header
Set WS = rStartCell.Worksheet
Set wb = WS.Parent
sSheet = "'" & WS.Name & "'"
With rStartCell
Rowno = .row
Set rData = .CurrentRegion
End With
Set rData = WS.range(rStartCell, WS.Cells(Rowno, rStartCell.Column))
Set rCol = rData.Columns
lCol = rCol.Column
wb.Names.Add Name:=Replace(rCol.Cells(1).Value, " ", "_"), _
RefersToR1C1:="=" & sSheet & "!" & rCol.Cells(2).Address(ReferenceStyle:=xlR1C1) & ":INDEX(C" & lCol & ",LOOKUP(2,1/(C" & lCol & "<>""""),ROW(C" & lCol & ")))"
End Sub
I want to modify this code so that instead of creating a named range it only returns the returns the range of the what would have been the named range.
Example:
We have a header in A1, and data in A2:A5.
Now: If we call CreateNamedRange(.range("A1")), it creates a dynamic named range for A2:A5.
Goal: If we call CreateNamedRange(.range("A1")) it returns .range("A2:A5") to a variable in the VBA code:
dim myRange As Range
set myRange = CreateNamedRange(.range("A1"))
First thing you should note is that Subs do not return any value and thus myRange = CreateNamedRange(.range("A1")) does not make any sense (with your Sub; it does make sense with the Function in this answer).
The function below returns a range, in the same column that the input range, starting from the next row and including all the ones below until finding a blank cell. This range is called "anyName" (and thus you can access it via Range("anyName")).
Private Function CreateNamedRange(header As Range) As Range
Dim curRow As Long: curRow = header.Row + 1
Set tempRange = header.Worksheet.Cells(curRow, header.Column)
Do While (Not IsEmpty(tempRange))
curRow = curRow + 1
Set tempRange = header.Worksheet.Cells(curRow, header.Column)
Loop
Set CreateNamedRange = header.Worksheet.Range(header.Worksheet.Cells(header.Row + 1, header.Column), header.Worksheet.Cells(curRow, header.Column))
CreateNamedRange.Name = "anyName"
End Function
If you already have the beginning cell activated you can just use
Set myRange = Range(ActiveCell.Address, ActiveCell.Offset.End(xlDown).Address)
to set your range for all entries below the active cell. If you don't have it activated, you can just use your rstartCell reference with an offset
Set myRange = Range(rStartCell.Offset(1), rStartCell.Offset(1).Offset.End(xlDown).Address)
Then you can just add the named range in the next line

Checking two ranges in different workbooks (run time error 424)

I am trying to check whether the values in workbook1-sheet1-A are matched in workbook2-sheet2-E. If there is a match workbook1-sheet1-Y receives a 'x'.
This is the code I have so far and gives me Run time error 424 - Object required error on the if loop.
Sub Check()
'
Application.ScreenUpdating = False
endRow = Range("A" & Rows.Count).End(xlUp).Row
wkbSLA = ("F:\Workbook2")
For i = 2 To endRow
If Cells(i, 1).Value = wkbSLA.Sheets("Sheet2").Range("E2:E575").Value Then
Range("Y" & i) = "x"
End If
Next i
'
End Sub
To ensure your code is doing everything you expect it to it, make sure you qualify your objects with variables.
Also, you cannot use the .Value property on multi-cell range. That is probably where your error is hitting. A better way to approach this is with the .Find method.
If you write the code something like this, it should work for you ... though you may need to tweak it a bit to meet your needs.
Option Explicit
Sub Check()
Application.ScreenUpdating = False
Dim wkb1 as Workbook, wkb2 as workbook
Set wkb1 = Workbooks("workbook1")
Set wkb2 = Workbooks("F:\Workbook2")
' -> do you need Workbooks.Open("F:\Workbook2") here?
' Seems you may if the workbook you want to access is closed
Dim wks1 as Worksheet, wks2 as Worksheet
Set wks1 = wkb1.Sheets(1) 'may need to change this reference for your needs
Set wks2 = wkb2.Sheets("Sheet2")
With wks1
Dim endRow as Long
endRow = .Range("A" & Rows.Count).End(xlUp).Row
Dim i as Long
For i = 2 To endRow
Dim rng as Range
Set rng = wks2.Range("E2:E575").Find .Cells(i,1).Value lookat:=xlWhole
If Not rng Is Nothing Then .Range("Y" & i) = "x"
Next i
End With
End Sub

Resources