How to go through each row within a selected range using VBA - excel

Ideally, I would have a range selected and then I would run the macro and I want the macro to essentially run a loop to go through each row so I can extract information from each row until it reaches the end of the range.
For example, A6:B9 are selected, first I want to focus on A6:B6. As in I want to be able to find the min value of the two cells for instance, using my MinSelected function(stated below) which requires a selected range which would ideally be A6:B6. And I want to do this for each row until the end of the original range.
Function MinSelected(R As Range)
MinSelected = Application.WorksheetFunction.min(R)
End Function
Is there any way to do this??? Please tell me to clarify anything that's unclear. Thanks in advance.

You can loop through rows - but looping through a variant array is more efficient (for many rows)
variant aray
Dim X
Dim lngCnt As Long
X = Range("A6:B9").Value2
For lngCnt = 1 To UBound(X)
Debug.Print Application.Min(Application.Index(X, lngCnt))
Next
range approach
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Range("A6:B9")
For Each rng2 In rng1.Rows
Debug.Print Application.Min(rng2)
Next

Use a For loop, Rows.Count property, Columns.Count
Dim i as long
For i = 1 to Selection.Rows.Count
For j = 1 To Selection.Columns.Count
Cells(i, j).Value ' Use this to access the value of cell in row i and column j

Related

Compare two data ranges and copy entire row into worksheet VBA

i have found many very similar questions in the forum, but somehow nothing fits what i am looking for.
I have two ranges (a & b) which i'd like to compare and if values do not match, i'd like to copy the entire row to a predefined worksheet. The purpose is to find rows / values that have been changed vs. previous edit.
Dim a, b as range
Dim ws1,ws2,ws3 as worksheet
Dim last_row, last_row2 as integer 'assume last_row =15, last_row2=12
Dim i, j, k as integer
last_row=15
last_row2=12
' the orignal range is not massive, but at 500x 6 not small either
Set a=ws1.range("I5:S"& last_row)
Set b=ws2.range("H2:R"& last_row2)
I have seen different approaches when it comes to addressing each item of the range and don't know which would be quickest / best (loop or for each ).
The main if-statement would look something like this:
'assume i, j are the used as counters running across the range
k = 1
If Not a(i).value=b(j).value then
a(i)EntireRow.copy
ws3.row(k).paste
k = k + 1
end if
The solution cannot be formula based, as I need to have ws3 saved after each comparison.
Any help on this is much appreciated. Thanks!
If you have the ability to leverage Excel Spill Ranges, you can achieve what you want without VBA. Here's a web Excel file that shows all rows in first sheet where column A does not equal column b.
=FILTER(Sheet1!A:ZZ,Sheet1!A:A<>Sheet1!B:B)
If VBA is required, this routine should work. It's not optimal for handling values (doesn't use an array), but it gets it done.
Sub listDifferences()
Dim pullWS As Worksheet, pushWS As Worksheet
Set pullWS = Sheets("Sheet1")
Set pushWS = Sheets("Sheet2")
Dim aCell As Range
For Each aCell In Intersect(pullWS.Range("A:A"), pullWS.UsedRange).Cells
If aCell.Value <> aCell.Offset(0, 1).Value Then
Dim lastRow As Long
lastRow = pushWS.Cells(Rows.Count, 1).End(xlUp).Row
pushWS.Rows(lastRow + 1).Value = aCell.EntireRow.Value
End If
Next aCell
End Sub
This is the small for-loop I ended up using.
Thanks for your input!
For i = 1 To rOutput.Cells.Count
If Not rOutput.Cells(i) = rBackUp.Cells(i) Then
' Debug.Print range1.Cells(i)
' Debug.Print range2.Cells(i)
rOutput.Cells(i).EntireRow.Copy wsChangeLog.Rows(k)
k = k + 1
End If
Next i

Using vba to find column headers and adding a new record under that header

I am trying to create something that is capable of taking the value from one text box, searching a group of column headers to find the correct one, and then placing a new value from a second text box into the last row under that column. I adapted this code that I found on here, https://stackoverflow.com/a/37687346/13073514, but I need some help. This code posts the value from the second text box under every header, and I would like it to only post it under the header that is found in textbox 1. Can anyone help me and explain how I can make this work? I am new to vba, so any explanations would be greatly appreciated.
Public Sub FindAndConvert()
Dim i As Integer
Dim lastRow As Long
Dim myRng As Range
Dim mycell As Range
Dim MyColl As Collection
Dim myIterator As Variant
Set MyColl = New Collection
MyColl.Add "Craig"
MyColl.Add "Ed"
lastRow = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For i = 1 To 25
For Each myIterator In MyColl
If Cells(1, i) = myIterator Then
Set myRng = Range(Cells(2, i), Cells(lastRow, i))
For Each mycell In myRng
mycell.Value = Val(mycell.Value)
Next
End If
Next
Next
End Sub
Basic example:
Sub tester()
AddUnderHeader txtHeader.Text, txtContent.Text
End Sub
'Find header 'theHeader' in row1 and add value 'theValue' below it,
' in the first empty cell
Sub AddUnderHeader(theHeader, theValue)
Dim m
With ThisWorkbook.Sheets("Data")
m = Application.Match(theHeader, .Rows(1), 0)
If Not IsError(m) Then
'got a match: m = column number
.Cells(.Rows.Count, m).End(xlUp).Offset(1, 0).Value = theValue
Else
'no match - warn user
MsgBox "Header '" & theHeader & "' not found!", vbExclamation
End If
End With
End Sub
I have commented your code for your better understanding. Here it is.
Public Sub FindAndConvert()
Dim i As Integer
Dim lastRow As Long
Dim myRng As Range
Dim myCell As Range
Dim MyColl As Collection
Dim myIterator As Variant
Set MyColl = New Collection
MyColl.Add "Craig"
MyColl.Add "Ed"
Debug.Print MyColl(1), MyColl(2) ' see output in the Immediate Window
' your code starts in the top left corner of the sheet,
' moves backward (xlPrevious) from there by rows (xlByRows) until
' it finds the first non-empty cell and returns its row number.
' This cell is likely to be in column A.
lastRow = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For i = 1 To 25 ' do the following 25 times
' in Cells(1, i), i represents a column number.
' 1 is the row. It never changes.
' Therefore the code will look at A1, B1, C1 .. until Y1 = cells(1, 25)
For Each myIterator In MyColl ' take each item in MyColl in turn
If Cells(1, i) = myIterator Then
' set a range in the column defined by the current value of i
' extend it from row 2 to the lastRow
Set myRng = Range(Cells(2, i), Cells(lastRow, i))
' loop through all the cells in myRng
For Each myCell In myRng
' convert the value found in each cell to a number.
' in this process any non-numeric cells would become zero.
myCell.Value = Val(myCell.Value)
Next myCell
End If
Next myIterator
Next i
End Sub
As you see, there is no TextBox involved anywhere. Therefore your question can't be readily understood. However, my explanations may enable you to modify it nevertheless. It's all a question of identifying cells in the worksheet by their coordinates and assigning the correct value to them.
Edit/Preamble
Sorry, didn't read that you want to use TextBoxes and to collect data one by one instead of applying a procedure to a whole data range.
Nevertheless I don't remove the following code, as some readers might find my approach helpful or want to study a rather unknown use of the Application.Match() function :)
Find all header columns via single Match()
This (late) approach assumes a two-column data range (header-id and connected value).
It demonstrates a method how to find all existant header columns by executing a single Application.Match() in a â–ºone liner ~> see step [3].
Additional feature: If there are ids that can't be found in existant headers the ItemCols array receives an Error items; step [4] checks possible error items adding these values to the last column.
The other steps use help functions as listed below.
[1] getDataRange() gets range data assigning them to variant data array
[2] HeaderSheet() get headers as 1-based "flat" array and sets target sheet
[3] see explanation above
[4] nxtRow() gets next free row in target sheet before writing to found column
Example call
Sub AddDataToHeaderColumn()
'[1] get range data assigning them to variant data array
Dim rng As Range, data
Set rng = getDataRange(Sheet1, data) ' << change to data sheet's Code(Name)
'[2] get headers as 1-based "flat" array
Dim targetSheet As Worksheet, headers
Set targetSheet = HeaderSheet(Sheet2, headers)
'[3] match header column numbers (writing results to array ItemCols as one liner)
Dim ids: ids = Application.Transpose(Application.Index(data, 0, 1))
Dim ItemCols: ItemCols = Application.Match(ids, Array(headers), 0)
'[4] write data to found column number col
Dim i As Long, col As Long
For i = 1 To UBound(ItemCols)
'a) get column number (or get last header column if not found)
col = IIf(IsError(ItemCols(i)), UBound(headers), ItemCols(i))
'b) write to target cells in found columns
targetSheet.Cells(nxtRow(targetSheet, col), col) = data(i, 2)
Next i
End Sub
Help functions
I transferred parts of the main procedure to some function calls for better readibility and as possible help to users by demonstrating some implicit ByRef arguments such as [ByRef]mySheet or passing an empty array such as data or headers.
'[1]
Function getDataRange(mySheet As Worksheet, data) As Range
'Purpose: assign current column A:B values to referenced data array
'Note: edit/corrected assumed data range in columns A:B
With mySheet
Set getDataRange = .Range("A2:B" & .Cells(.Rows.Count, "B").End(xlUp).Row)
data = getDataRange ' assign range data to referenced data array
End With
End Function
'[2]
Function HeaderSheet(mySheet As Worksheet, headers) As Worksheet
'Purpose: assign titles to referenced headers array and return worksheet reference
'Note: assumes titles in row 1
With mySheet
Dim lastCol As Long: lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
headers = Application.Transpose(Application.Transpose(.Range("A1").Resize(1, lastCol)))
End With
Set HeaderSheet = mySheet
End Function
'[4]
Function nxtRow(mySheet As Worksheet, ByVal currCol As Long) As Long
'Purpose: get next empty row in currently found header column
With mySheet
nxtRow = .Cells(.Rows.Count, currCol).End(xlUp).Row + 1
End With
End Function

How to Add a Data Bar in Every Other Cell within a Range of Cells?

I have coded a specific type of data bar I need in excel. I'm trying to apply this data bar to every other cell in a range of cells. It keeps applying it to all of my cell in my specific range instead of every other one. This is driving me crazy! Please help!
Sub ShadeEveryOtherRow()
Dim Counter As Integer
Dim rng As Range
Set rng = ActiveSheet.Range("N4:N120")
Dim cell As Range
'For every row in the current selection...
For Counter = 1 To Selection.Rows.Count
'If the row is an odd number (within the selection)...
For Each cell In rng.Cells
If Counter Mod 2 = 1 Then
Call Add_Data_Bar(cell, cell.Value)
End If
Next cell
Next Counter
End Sub
You need to use step 2 for your counter. You also need Counter to be defined as an object for Rows. Hope this example helps:
Sub ShadeEveryOtherRow()
Dim Counter As Integer
Dim rng As Range
Set rng = ActiveSheet.Range("N4:N120")
Dim cell As Range
'For every row in the current selection...
For Counter = 1 To rng.Rows.Count Step 2
rng.Rows(Counter).FormatConditions.AddDatabar
Next Counter
End Sub

Non-contiguous For Each loop per row instead of column

I have a non-contiguous selection spanning rows and columns, and I want to do a For Each loop on it. Excel VBA does this by looping firstly down column 1, then 2,3 etc.; but I want it to loop along the row first instead.
(My sheet looks something like the picture below, I need to loop down the selection (version) each column in turn, and retrieve the Doc. No. and other information. The number of rows and version columns in the sheet is not fixed).
Short of writing a fairly large Sort function and creating an array of references, I was wondering if there was a 'built-in' way to do this?
I don't need code, just an explanation.
The order in which a For Each iterates an object collection is implementation-dependent (IOW blame Excel, not VBA) and, while likely deterministic & predictable, there is nothing in its specification that guarantees a specific iteration order. So VBA code written to iterate an object collection, should not be written with the assumption of a specific iteration order, since that's something that can very well change between versions of the type library involved (here Excel's).
It's very unclear what the shape of your Range / Selection is, but if you need to iterate the selected cells in a specific order, then a For Each loop should not be used, at least not for iterating the cells per se.
Since the ranges are not contiguous, the Range will have multiple Areas; you'll want to iterate the Selection.Areas, and for each selected area, iterate the cells in a particular order. For Each is, by far, the most efficient way to iterate an object collection, which Range.Areas is.
Debug.Assert TypeOf Selection Is Excel.Range
Dim currentArea As Range
For Each currentArea In Selection.Areas
'todo
Next
Instead of nesting the loops, make a separate procedure that takes the currentArea as a parameter - that procedure is where you'll be iterating the individual cells:
Private Sub ProcessContiguousArea(ByVal area As Range)
Dim currentRow As Long
For currentRow = 1 To area.Rows.Count
Debug.Print area.Cells(currentRow, 1).Address
Next
End Sub
Now the outer loop looks like this:
Debug.Assert TypeOf Selection Is Excel.Range
Dim currentArea As Range
For Each currentArea In Selection.Areas
ProcessContiguousArea currentArea
Next
The ProcessContiguousArea procedure is free to do whatever it needs to do with a given contiguous area, using a For loop to iterate the range by rows, without needing to care for the actual address of the selected area: using Range.Cells(RowIndex, ColumnIndex), row 1 / column 1 represents the top-left cell of that range, regardless of where that range is located in the worksheet.
Non-selected cells can be accessed with Range.Offset:
Debug.Print area.Cells(currentRow, 1).Offset(ColumnOffset:=10).Address
The top-left cell's row of the area on the worksheet is returned by area.Row, and the top-left cell's column of the area on the worksheet is retrieved with area.Column.
Non-Contiguous
By looping through the rows first (i), you will get the 'By Row sequence' e.g. A1,B1,C1, ...
The Code
Sub NonContiguous()
Dim i As Long
Dim j As Long
Dim k As Long
With Selection
For k = 1 To .Areas.Count
With .Areas(k)
For i = .Row To .Rows.Count + .Row - 1
For j = .Column To .Columns.Count + .Column - 1
Debug.Print .Parent.Cells(i, j).Address & " = " _
& .Parent.Cells(i, j)
Next
Next
End With
Next
End With
End Sub
This is based on urdearboy's suggestion:
1. loop over columns
2. within a column, loop over cells
Sub disjoint()
Dim r As Range, rInt As Range
Dim nLastColumn As Long
Dim nFirstColumn As Long, msg As String
Dim N As Long
Set r = Range("C3,C9,E6,E13,E15,G1,G2,G3,G4")
nFirstColumn = Columns.Count
nLastColumn = 0
msg = ""
For Each rr In r
N = rr.Column
If N < nFirstColumn Then nFirstColumn = N
If N > nLastColumn Then nLastColumn = N
Next rr
For N = nFirstColumn To nLastColumn
Set rInt = Intersect(Columns(N), r)
If rInt Is Nothing Then
Else
For Each rr In rInt
msg = msg & vbCrLf & rr.Address(0, 0)
Next rr
End If
Next N
MsgBox msg
End Sub

Assigning a specific cell from a Range to a variable VBA

Is there a way to store specific cells into new variables from a range in VBA? What I mean is...
Suppose I have set the data below to a range call "numbers".
Now in VBA, for each row I want to extract each individual cell value and assign each value to a different variable. And then repeat again for the next row.
I essentially want to the use the values in a given row to do something and then have it repeat again for the next row.
Does this make sense???
This is what I've been playing around with... but I don't get how to assign each cell from a given row to a new variable
Public Sub try()
Dim rng As Range
Dim row As Range
Dim cell As Range
Dim n As Double
Set rng = Range("numbers")
For Each row In rng.Rows
For Each cell In row.Cells
n = cell.value
Next cell
Next row
End Sub
Try this:
Dim numberArray As Variant
' this line will assign numbers inside the range to an array
numberArray = Range("numbers").Value2
' now you are able to access all numbers in you range through this array, like this:
MsgBox numberArray(1, 1) 'it will show 1
The way you are doing it right now doesn't make sense, since you are assigning all values to one variable n, so on every iteration of a loop previous value gets overwritten, resulting in n having last value in a range, which is 3.
Is there any particular reason you want to store any cell value in a new variable?
With a given range it would be very easy to just store your values in a Variant Array. In your example it would be something like:
Public Sub try()
Dim rng As Range
Dim dataArray as Variant
Set rng = Range("numbers")
dataArray = rng
debug.print dataArray(1, 2) 'This would print 7 in your example range
end sub
You could then easily loop through your Variant Array like this:
Dim i as Long, j as Long
For i = 1 To UBound(dataArray, 1) 'This will loop through each row
For j = 1 To UBound(dataArray, 2) 'This will loop through each column (cell in your row)
Debug.Print dataArray(i, j)
Next
Next
UBound() returns the length of the Array at the given dimension as the second parameter. I am just printing the values again since I do not know what exactly your intention is.

Resources