VBA dynamic loop macro - vba

I am trying to build a loop macro is visual basic which takes cells from a range in one worksheet and places them in to specific cells in other worksheet directed by the worksheet's tab name in a parallel range. The ranges need to be variable - with more or less data as directed.
This is the code which currently works for one cell:
Sub Ticker_input()
Dim wsname As String
wsname = ActiveCell.Value
Worksheets("Summary").Range("Tab_name").Select
Worksheets(wsname).Range("CapIQ_ticker").Value = ActiveCell.Offset(0, 1)
End Sub
I need to turn this into a loop macro.
Help would be greatly appreciated.

There are multiple ways to do loops in VBA. This is one way that could apply to your situation:
Sub Ticker_input()
On Error Resume Next
Application.ScreenUpdating = False
Dim wsname As String
Dim rTabNames As Range, c As Range
Set rTabNames = Worksheets("Summary").Range("Tab_name")
For Each c In rTabNames
If c.Value <> "" Then
wsname = c.Value
Worksheets(wsname).Range("CapIQ_ticker").Value = c.Offset(0, 1).Value
End If
Next
Application.ScreenUpdating = True
End Sub
Just make sure your named range "Tab_name" is the entire range of cells that could contain sheet names (for example, if you list your sheet names in A, have "Tab_name" be referring to that entire column), as opposed to one cell.

I'm not exactly sure what you are trying to accomplish, but below is an example of looping through a named range. It is dnyamic in the fact that it will loop through the named range and if you reset the size of the named range it will only loop through those cells.
~ hope this helps.
Sub loopRnage()
'create your variable outside the loop
Dim wsname
'tell the loop the range you want to loop through
For Each cell In ThisWorkbook.Sheets("Stocks").Range("symbols")
'set the variable to the current cell
wsname = cell.Value
Worksheets("Summary").Range("Tab_name").Select
'use the variable to set the target name
Worksheets(wsname).Range("CapIQ_ticker").Value = cell.Offset(0, 1)
Next cell
End Sub

Related

Fill Empty Blank Cells with value within a region horizontaly defined

I'm trying to fill blank cells in a certain region with 0. The reagion should be defined in the current workbook but in sheet2 (not the current sheet). Also the place where it is supposed to fill is between columns
BU:CQ in the current region (not all 100 000 000 lines). Just the number of lines that define the table between columns BU and CQ. I know the problem lies in defining the region... See the code below.
What is missing?
Sub FillEmptyBlankCellWithValue()
Dim cell As Range
Dim InputValue As String
On Error Resume Next
InputValue = "0"
For Each cell In ThisWorkbook.Sheets("Sheet2").Range(BU).CurrentRegion
'.Cells(Rows.Count, 2).End(xlUp).Row
If IsEmpty(cell) Then
cell.Value = InputValue
End If
Next
End Sub
I've this code that i'm positive that works! But i don't wnat selection! I want somthing that specifies the sheet and a fixed range.
Now my idea is to replace "selection" with the desired range. - In this case in particular the range should be 1 - between BU:CQ; 2 - starting at row 2; 3 - working the way down until last row (not empty = end of the table that goes from column A to DE)
Sub FillEmptyBlankCellWithValue()
Dim cell As Range
Dim InputValue As String
On Error Resume Next
For Each cell In Selection
If IsEmpty(cell) Then
cell.Value = "0"
End If
Next
End Sub'
PS: And I also need to specify the sheet, since the button that will execute the code will be in the same workbook but not in the same sheet.
Use SpecialsCells:
On Error Resume Next 'for the case the range would be all filled
With ws
Intersect(.UsedRange, .Range("BU:CQ")).SpecialCells(xlCellTypeBlanks).Value = 0
End With
On Error GoTo 0
MUCH faster than looping !
Try using cells() references, such as:
For i = cells(1,"BU").Column to cells(1,"CQ").Column
cells(1,i).value = "Moo"
Next i
In your current code you list Range(BU) which is not appropriate syntax. Note that Range() can be used for named ranges, e.g., Range("TheseCells"), but the actual cell references are written as Range("A1"), etc. For Cell(), you would use Cells(row,col).
Edit1
With if statement, with second loop:
Dim i as long, j as long, lr as long
lr = cells(rows.count,1).end(xlup).row
For i = 2 to lr 'assumes headers in row 1
For j = cells(1,"BU").Column to cells(1,"CQ").Column
If cells(i,j).value = "" then cells(i,j).value = "Moo"
Next j
Next i
First off, you should reference the worksheet you're working with using:
Set ws = Excel.Application.ThisWorkbook.Worksheets(MyWorksheetName)
Otherwise VBA is going to choose the worksheet for you, and it may or may not be the worksheet you want to work with.
And then use it to specify ranges on specific worksheets such as ws.Range or ws.Cells. This is a much better method for specifying which worksheet you're working on.
Now for your question:
I would reference the range using the following syntax:
Dim MyRange As Range
Set MyRange = ws.Range("BU:CQ")
I would iterate through the range like so:
Edit: I tested this and it works. Obviously you will want to change the range and worksheet reference; I assume you're competent enough to do this yourself. I didn't make a variable for my worksheet because another way to reference a worksheet is to use the worksheet's (Name) property in the property window, which you can set to whatever you want; this is a free, global variable.
Where I defined testWS in the properties window:
Public Sub test()
Dim MyRange As Range
Dim tblHeight As Long
Dim tblLength As Long
Dim offsetLen As Long
Dim i As Long
Dim j As Long
With testWS
'set this this to your "BU:CQ" range
Set MyRange = .Range("P:W")
'set this to "A:BU" to get the offset from A to BU
offsetLen = .Range("A:P").Columns.Count - 1
'set this to your "A" range
tblHeight = .Range("P" & .Rows.Count).End(xlUp).Row
tblLength = MyRange.Columns.Count
End With
'iterate through the number of rows
For i = 1 To tblHeight
'iterate through the number of columns
For j = 1 To tblLength
If IsEmpty(testWS.Cells(i, offsetLen + j).Value) Then
testWS.Cells(i, offsetLen + j).Value = 0
End If
Next
Next
End Sub
Before:
After (I stopped it early, so it didn't go through all the rows in the file):
If there's a better way to do this, then let me know.

Loop Through Non Blank Cells

I just want to know how to loop through the non blank cells on Column A. What I'm trying to do is copy the contents on [A1:B1] to be added on top of each non blank cells on Column A. So far I have counted the non blank cells on column A but I'm stuck. I know that an Offset function should be used for this.
Here's my code so far:
Dim NonBlank as Long
NonBlank = WorksheetFunction.CountA(Worksheet(1).[A:A])
For i = 1 to NonBlank
[A1:B1].Copy Offset(1,0). "I'm stuck here"
Next i
If you are trying to fill the headers for each Product, try this...
Sub FillHeaders()
Dim lr As Long
Dim Rng As Range
lr = ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
On Error Resume Next
Range("A1:B1").Copy
For Each Rng In Range("A3:A" & lr).SpecialCells(xlCellTypeConstants, 2).Areas
If Rng.Cells(1).Value <> Range("A1").Value Then
Rng.Cells(1).Offset(-1, 0).PasteSpecial xlPasteAll
End If
Next Rng
Application.CutCopyMode = 0
Application.ScreenUpdating = True
End Sub
As example to simulate the effect of Ctrl-Down from Cell A1 and display the Address, Value in the Immediate Window:
Sub HopToNextNonBlankCellBelow()
Dim oRng As Range
Set oRng = Range("A1")
Debug.Print "Cell Address", "Cell Value"
Do
Set oRng = oRng.End(xlDown)
If Not IsEmpty(oRng) Then Debug.Print oRng.Address(0, 0), oRng.Value
Loop Until oRng.Row = Rows.Count
Set oRng = Nothing
End Sub
Try this... I've (probably) overcounted the rows at 1000, but it likely won't make a difference with your performance. If you wanted to be more precise, there are hundreds of articles on how to find the last row of a range. As for the Offset function, it references a cell in relation to the one we're looping through. In the example below, the code is saying cell.offset(0,1) which means one cell to the right of the cell we are currently looping through. A clearer (less loopy!) example would be if you typed: Range("A10").offset(0,1) it would be the same as typing Range("B10")
Dim Cell As Range
For Each Cell In Range("A2:A1000").Cells
If Not IsEmpty(Cell) Then
Cell.Offset(0, 1).Value = Cell.Value
End If
Next Cell

Find Multiple Instances of Value in Spreadsheet

I'm trying to create a macro in VBA that will search through a column in "PasteSheet" for any cell that contains the word "conversion". Once I have that cell, I can gather other information in other columns that correspond to that row. The problem I am encountering is creating some type of loop that will run through the entire database to return all instances of the word "conversion". Here is my code so far:
Sub Conversion()
Dim Comment As Range
Dim i As String
Worksheets("PasteSheet").Activate
Range("Comment").Find("conversion").Select
Worksheets("sheet1").Range("a1") = Selection.Offset(0, -8)
End Sub
Help please!
Here's one way you can do it. This will save the addresses of the found word in an array, and you can use that array however you like at the end. I used column D as my example column. Change anything as necessary
Sub getCells()
Dim rng As Range, cel As Range
Dim celAddress() As Variant
Dim i As Long
i = 0
Set rng = Range("D1:D" & Cells(Rows.Count, 4).End(xlUp).Row)
ReDim cellAddress(rng.Cells.Count)
For Each cel In rng
If cel.Value = "conversion" Then
cellAddress(i) = cel.Address
i = i + 1
End If
Next cel
ReDim Preserve cellAddress(i - 1)
For i = LBound(cellAddress) To UBound(cellAddress)
' Do whatever with each cell address found
Debug.Print cellAddress(i)
Next i
End Sub

Loops in VBA? I want to use a loop to select and copy till last cell

I am trying to select each consecutive cell in Row K (starting from Range K1), and for each cell going down, copy the value and paste it into Cell M10. However, the way the macro is written currently, the macro is selecting the cell right below the last cell in Range K, and is thus copying a blank into M10. Instead, I want the loop to work down one cell at a time. I want to select one cell at a time and copy it, i.e. the Loop will select K1 and copy it to M10, then select K2 and copy it to M10, etc, and then have the loop stop after the last cell of Range K.
Can anyone please help me out on this?
Sub test()
lastcell = Range("K" & Cells.Rows.Count).End(xlUp)
Range("K2").Select
Do
ActiveCell.Offset(1, 0).Select
Selection.Copy
Range("M10").Select
Selection.PasteSpecial
Application.Run ("Second Macro")
Loop Until IsEmpty(ActiveCell.Value)
End Sub
You can loop through column K using the small script below:
Option Explicit
Sub LoopThroughColumnK()
Dim LastRowInColK As Long, Counter As Long
Dim SourceCell As Range, DestCell As Range
Dim MySheet As Worksheet
'set references up-front
Set MySheet = ThisWorkbook.Worksheets("Sheet1")
With MySheet
LastRowInColK = .Range("K" & .Rows.Count).End(xlUp).Row
Set DestCell = .Range("M10")
End With
'loop through column K, copying from cells(counter, 11) to M10
With MySheet
For Counter = 1 To LastRowInColK
Set SourceCell = .Range("K" & Counter)
SourceCell.Copy Destination:=DestCell
'call MyMacro below
'... doing cool MyMacro stuff
Next Counter
End With
End Sub
To summarize what's happening, we:
Assign a worksheet variable to make sure we're working on the right sheet
Assign easy-to-read and reference variables for the last row and cell M10
Loop through the range in question, copying and pasting from Kn to M10
This technique also avoids using .Select, a common source of run-time errors. Here's an AMAZING post outlining lots of ways to NOT use .Select and .Activate: How to avoid using Select in Excel VBA macros
Edit: The refactoring I described in my comment above could be implemented without too much struggle. Let's break the whole problem into two bite-size chunks:
Get all the occupied cells in column K and save them as a Range
Running your secondary macro, which was keyed off cell M10, for each Cell in the Range we saved in step #1 above. We'll call the secondary macro MyOtherMacro for now
Let's get after it. Sunday Funday y'all! The code below is heavily-commented to explain what's happening in each function and step:
Option Explicit
Sub DoWork()
Dim MySheet As Worksheet
Dim ColKRange As Range
'set the worksheet we want to work on, in this case "Sheet1"
Set MySheet = ThisWorkbook.Worksheets("Sheet1")
'get the range of occupied cells in col K
Set ColKRange = OccupiedRangeInColK(MySheet)
'kick off the other macro using the range we got in the step above
Call MyOtherMacro(ColKRange)
End Sub
DoWork (above) is a "controller"-type script. All it does is kick off the other two functions we have written below, OccupiedRangeInColK and then, one step later, MyOtherMacro.
'this function returns a range object representing all
'the occupied cells in column K, starting at row 1 and ending
'at the last occupied row (in column K)
Public Function OccupiedRangeInColK(TargetSheet As Worksheet) As Range
Dim LastRow As Long
'check for unassigned worksheet object, return nothing if that's the case
If TargetSheet Is Nothing Then
Set OccupiedRangeInColK = Nothing
End If
With TargetSheet
LastRow = .Range("K" & .Rows.Count).End(xlUp).Row
Set OccupiedRangeInColK = .Range(.Cells(1, 11), .Cells(LastRow, 11))
End With
End Function
Cool -- descriptive names are a great thing when it comes to scripting. OccupiedRangeInColK (above) takes a Worksheet, then returns the occupied Range from column K.
'this function is a shell to be populated by #polymorphicicebeam
Public Function MyOtherMacro(TargetRange As Range)
Dim Cell As Range
'check for an empty range, exit the function if empty
If TargetRange Is Nothing Then Exit Function
'loop through all the cells in the passed-in range
For Each Cell In TargetRange
'Do cool stuff in here. For demo purposes, we'll just
'print the address of the cell to the screen
MsgBox (Cell.Address)
Next Cell
End Function
Finally, MyOtherMacro (above) is where you get to add your own magic. I built a "shell" function for you, which simply prints the address of the cell in question with a MsgBox. You can add your own logic where indicated inside the For Each Cell In TargetRange loop. Woo!

How to find a specific cell and make it the ActiveCell

I am writing a VBA code that will open a specific worksheet in my workbook in Excel, and then find the cell in Column A that has the value "TOTAL". This then must be set as the ActiveCell, so that the rest of my macro can perform actions on the row containing this cell.
I want it so that when the user runs the macro, this cell is specifically chosen right off the bat. The position of this cell will change after the macro is run, so I need it to work no matter what cell this value is in. Everytime the macro runs, a new row is added above the row containing "TOTAL" and therefore the position of this cell is ever-changing.
So far I have come up with this, just from readin through forums. It still doesn't work, but I'm new to this language and I can't determine where the error is.
Sub Macro2()
Dim C As Range
Worksheets("Project Total").Select
With Selection
C = .Find("TOTAL", After:=Range("A2"), MatchCase:=True)
End With
End Sub
Try this:
Sub Macro2()
Dim cl As Range
With Worksheets("Project Total").Cells
Set cl = .Find("TOTAL", After:=.Range("A2"), LookIn:=xlValues)
If Not cl Is Nothing Then
cl.Select
End If
End With
End Sub
Try this:
Sub activateCellContainingTOTAL()
'Go to the worksheet
Worsheets("Project Total").Activate
'Start going down column A to see if you find the total
dim loopBool as Boolean
loopBool = True
Worksheets("Project Total").Range("A1").Activate
Do While loopBool=True
if Activecell.value = "TOTAL" then
loop = false
else
activecell.offset(1, 0).Activate
end if
loop
End sub
Sub Getvaluesfromeachcolumns()
Dim loopcounter As Integer
Dim loopcounter1 As Integer
Dim dumvalue As String
Dim rrange As Range
dumvalue = Activecell.value 'you can replace your cell reference or any value which you want to search. also you can use input method.'
loopcounter1 = Range("A1:C1").Count
For loopcounter = 1 To loopcounter1
Cells(1, loopcounter).Select
Range(ActiveCell.Address).Select ' to know the active cell and address
Set rrange = Range(ActiveCell.Address, ActiveCell.End(xlDown)).Find(dumvalue)
rrange.Select
Next loopcounter
End Sub