I have three different named ranges, I want the macro to copy all three, to consolidate them all (each on one separate line), and to paste them in one single cell in another worksheet.
Dim range1 As Range, range2 As Range, range3 As Range, multipleRange As Range
Set range1 = wsForm.Range("Details_Absenteisme")
Set range2 = wsForm.Range("Boite_Infraction")
Set range3 = wsForm.Range("Boite_Corrections")
Set multipleRange = Union(range1, range2, range3)
ws_operation.Range("I" & lrow_operation).Value = multipleRange
This only paste the value in range1.
Concatenate the values together and then paste them into the cell you want.
I added a space in between the different values.
dim copystr as string
copystr = wsForm.Range("Details_Absenteisme").value & _
" " & wsForm.Range("Boite_Infraction").value & _
" " & wsForm.Range("Boite_Corrections").value
ws_operation.Range("I" & lrow_operation).Value = copystr
Loop the pre mention ranges and get all the values included. This is used in case you have many cells in your range
Sub test()
Dim nameRng As Variant
Dim i As Long
Dim cell As Range
Dim str As String
nameRng = Split("Details_Absenteisme,Boite_Infraction,Boite_Corrections", ",")
str = ""
For i = LBound(nameRng) To UBound(nameRng)
With wsForm
For Each cell In .Range(nameRng(i))
If str = "" Then
str = cell.Value
Else
str = str & " " & cell.Value
End If
Next cell
End With
Next i
MsgBox str
End Sub
Related
I am trying to convert a text file to Excel sheet. I have to remove some data elements and copy some data elements to several columns. To remove some data, I have to look for a certain String (RUN). After I have that address, I have to search for the next RUN. Inside those two String range, I have to search for another String (NET) and remove it. I have to do it throughout the datasheet since this is frequent.
Here is the code I am trying to use.
Dim name As String: name = "RUN"
Dim secondName As String: secondName = "NET"
Dim rgSearch As Range
' set the range to entire sheet
Set rgSearch = Range(Cells.Address)
Dim rgSearch1 As Range
Dim cell As Range
'search for first occurrence of RUN
Set cell = rgSearch.Find(name)
Dim tempCell As Range
' If not found then exit
If cell Is Nothing Then
Debug.Print "Not found"
Exit Sub
End If
' Store first cell address
Dim firstCellAddress As String, firstRow As Integer, secondRow As Integer
'store address of first result
firstCellAddress = cell.Address
secondRow = cell.Row
Do
'save range to another range for next iteration
Set tempCell = cell.Select
'row variables are for alternate solution I tried
firstRow = secondRow
Debug.Print "Found: " & cell.Address
' search for next instance
Set cell = rgSearch.FindNext(cell)
,set next instance
secondRow = cell.Row
Set rgSearch1 = Range(tempCell, cell).Select
Loop While firstCellAddress <> cell.Address
I have also tried using
Set rgSearch1 = Range("B" & firstRow + 1 & ":B" & secondRow - 1).Select
instead of putting cells inside the range but I get the same result. That is why those firstRow, secondRow variables are there.
With both ideas, I am getting Object Required error. Could someone please show me what I am doing wrong?
I'm requesting a parameter from the user to specify columns (in Excel) to select, but am having some issues with converting the value to a string that I can use in VBA for reference.
I'm trying to avoid having the user enter A:A,E:E,D:D,S:S and instead just enter A,E,D,S in a cell. I'm sure the answer is right there but at the moment it's escaping me. Any suggestions?
Like I said,
Split on the , and iterate through the resultant array and build the range:
Sub fooooo()
Dim str As String
Dim rng As Range
Dim strArr() As String
str = "A,E,D,S" 'you can change this to the cell reference you want.
strArr = Split(str, ",")
With Worksheets("Sheet1") ' change to your sheet
Set rng = .Range(strArr(0) & ":" & strArr(0))
For i = 1 To UBound(strArr)
Set rng = Union(rng, .Range(strArr(i) & ":" & strArr(i)))
Next i
End With
Debug.Print rng.Address
End Sub
You can always turn this into a Function that returns a range:
Function fooooo(str As String, ws As Worksheet) As Range
Dim rng As Range
Dim strArr() As String
strArr = Split(str, ",")
With ws ' change to your sheet
Set rng = .Range(strArr(0) & ":" & strArr(0))
For i = 1 To UBound(strArr)
Set rng = Union(rng, .Range(strArr(i) & ":" & strArr(i)))
Next i
End With
Set fooooo = rng
End Function
Then you would call it like this from any sub you need:
Sub foofind()
Dim rng As Range
Dim str As String
str = "A,E,D,S"
Set rng = fooooo(str, Worksheets("Sheet1"))
Debug.Print rng.Address
I have this code (This code is in Access VBA which tries to read an excel file and after checking, possibly import it):
Set ExcelApp = CreateObject("Excel.application")
Set Workbook = ExcelApp.Workbooks.Open(FileName)
Set Worksheet = Workbook.Worksheets(1)
now I want to iterate over all rows of the excel worksheet. I want something such as this:
for each row in Worksheet.rows
ProcessARow(row)
next row
where
function ProcessARow(row as ???? )
' process a row
' how Should I define the function
' how can I access each cell in the row
' Is there any way that I can understand how many cell with data exist in the row
end function
My questions:
How to define the for each code that it iterate correctly on all
rows that has data?
How to define ProcessARow properly
How to get the value of each cell in the row.
How to find how many cell with data exist in the row?
Is there any way that I detect what is the data type of each cell?
edit 1
The link solves on problem :
How to define the for each code that it iterate correctly on all rows that has data?
but what about other questions?
For example, how to define ProcessARow correctly?
If you need the values in the Row, you need use the 'Value' Property and after do an cycle to get each value
for each row in Worksheet.rows
Values=row.Value
For each cell in Values
ValueCell=cell
next cell
next row
Unfortunately you questions are very broad however I believe the below sub routine can show you a few ways of achieving what you are after. In regards to what datatype each cell is more involved as it depends what data type you wish to compare it to however I have included some stuff to hopefully help.
sub hopefullyuseful()
dim ws as worksheet
dim rng as Range
dim strlc as string
dim rc as long, i as long
dim lc as long, j as long
dim celltoprocess as range
set ws = activeworkbook.sheets(activesheet.name)
strlc = ws.cells.specialcells(xlcelltypeLastCell).address
set rng = ws.range("A1:" & lc)
rc = rng.rows.count()
debug.print "Number of rows: " & rc
lc = rng.columns.count()
debug.print "Number of columns: " & lc
'
'method 1 looping through the cells'
for i = 1 to rc
for j = 1 to lc
set celltoprocess = ws.cells(i,j)
'this gives you a cell object at the coordinates of (i,j)'
'[PROCESS HERE]'
debug.print celltoprocess.address & " is celltype: " & CellType(celltoprocess)
'here you can do any processing you would like on the individual cell if needed however this is not the best method'
set celltoprocess = nothing
next j
next i
'method 2 looping through the cells using a for each loop'
for each celltoprocess in rng.cells
debug.print celltoprocess.address & " is " & CellType(celltoprocess)
next celltoprocess
'if you just need the data in the cells and not the actual cell objects'
arrOfCellData = rng.value
'to access the data'
for i = lbound(arrOfCellData,1) to ubound(arrOfCellData,1)
'i = row'
for j = lbound(arrOfCellData,2) to ubound(arrOfCellData,2)
'j = columns'
debug.print "TYPE: " & typename(arrOfCellData(i,j)) & " character count:" & len(arrOfCellData(i,j))
next j
next i
set rng=nothing
set celltoprocess = nothing
set ws = nothing
end sub
Function CellType(byref Rng as range) as string
Select Case True
Case IsEmpty(Rng)
CellType = "Blank"
Case WorksheetFunction.IsText(Rng)
CellType = "Text"
Case WorksheetFunction.IsLogical(Rng)
CellType = "Logical"
Case WorksheetFunction.IsErr(Rng)
CellType = "Error"
Case IsDate(Rng)
CellType = "Date"
Case InStr(1, Rng.Text, ":") <> 0
CellType = "Time"
Case IsNumeric(Rng)
CellType = "Value"
End Select
end function
sub processRow(byref rngRow as range)
dim c as range
'it is unclear what you want to do with the row however... if you want
'to do something to cells in the row this is how you access them
'individually
for each c in rngRow.cells
debug.print "Cell " & c.address & " is in Column " & c.column & " and Row " & c.row & " has the value of " & c.value
next c
set c = nothing
set rngRow = nothing
exit sub
if you want your other questions answered you will have to be more specific as to what you are trying to accomplish
While I like the solution offered by #krazynhazy I believe that the following solution might be slightly shorter and closer to what you asked for. Still, I'd use the CellType function offered by Krazynhazy rather than all the Iif I currently have in the below code.
Option Explicit
Sub AllNonEmptyCells()
Dim rngRow As Range
Dim rngCell As Range
Dim wksItem As Worksheet
Set wksItem = ThisWorkbook.Worksheets(1)
On Error GoTo EmptySheet
For Each rngRow In wksItem.Cells.SpecialCells(xlCellTypeConstants).EntireRow.Rows
Call ProcessARow(wksItem, rngRow.Row)
Next rngRow
Exit Sub
EmptySheet:
MsgBox "Sheet is empty." & Chr(10) & "Aborting!"
Exit Sub
End Sub
Sub ProcessARow(wksItem As Worksheet, lngRow As Long)
Dim rngCell As Range
Debug.Print "Cells to process in row " & lngRow & ": " & wksItem.Range(wksItem.Cells(lngRow, 1), wksItem.Cells(lngRow, wksItem.Columns.Count)).SpecialCells(xlCellTypeConstants).Count
For Each rngCell In wksItem.Range(wksItem.Cells(lngRow, 1), wksItem.Cells(lngRow, wksItem.Columns.Count)).SpecialCells(xlCellTypeConstants)
Debug.Print "Row: " & lngRow, _
"Column: " & rngCell.Column, _
"Value: " & rngCell.Value2, _
IIf(Left(rngCell.Formula, 1) = "=", "Formula", IIf(IsDate(rngCell.Value), "Date", IIf(IsNumeric(rngCell.Value2), "Number", "Text")))
Next rngCell
End Sub
Note, that you have to call the sub to call a row must also include the sheet on which a row should be processed.
With the union statement I created a range existing of multiple subranges, of Worksheet("data"). I need that range for calculations on another worksheet, Worksheet("weekly"). Therefore I want the address of the range including the sheet name in each subrange. rRng is my range existing of several subranges.
rRng.Address(External:=True) returns: "data!$D$1570:$D$1575,$D$2992:$D$3000,$D$5979:$D$5988"
However, to calculate the average of the cells in this range I need: "data!$D$1570:$D$1575,data!$D$2992:$D$3000,data!$D$5979:$D$5988"
The only solution I found so far is:
Dim range_string As String
range_string = ""
Dim SubRange As range
For Each SubRange In rRng
range_string = range_string & SubRange.Address(External:=True) & ","
Next SubRange
range_string = Left(range_string, (Len(range_string) - 1))
Worksheets("weekly").range("$C2").Formula = "=AVERAGE(" & range_string & ")"
There must be a more easy way. Any suggestions?
Kind regards,
Sandra
Each of those subranges is called an Area. You can loop through the Areas of a range and build the string. Here's an example.
Sub test()
Dim rng As Range
Dim rArea As Range
Dim sForm As String
'union the ranges
Set rng = Sheet1.Range("D1570:d1575")
Set rng = Union(rng, Sheet1.Range("D2992:d3000"))
'loop through the areas and build the string
For Each rArea In rng.Areas
sForm = sForm & rArea.Address(, , , True) & ","
Next rArea
'remove the last comma
sForm = Left$(sForm, Len(sForm) - 1)
'insert the formula
Sheet2.Range("A1").Formula = "=AVERAGE(" & sForm & ")"
Debug.Print Sheet2.Range("A1").Formula
End Sub
The debug.print produces:
=AVERAGE(data!$D$1570:$D$1575,data!$D$2992:$D$3000)
I am working through my first VBA book and would appreciate if someone would point me in the right direction. How would I transfer a range of rows into a single cell with carriage returns? I would then like to repeat this action for all ranges in the column.
I think I need to:
find the first cell with a value in the column
verify that the next row is not empty
find the last cell in the range
perform "the operation" on the range
Following up on my comments. here is a very simple way to achieve what you want.
Option Explicit
'~~> You can use any delimiter that you want
Const Delim = vbNewLine
Sub Sample()
Dim rngInput As Range, rngOutput As Range
Application.ScreenUpdating = False
Set rngInput = Range("A1:A5") '<~~ Input Range
Set rngOutput = Range("B1") '<~~ Output Range
Concatenate rngInput, rngOutput
Application.ScreenUpdating = True
End Sub
Sub Concatenate(rng1 As Range, rng2 As Range)
Dim cl As Range
Dim strOutPut As String
For Each cl In rng1
If strOutPut = "" Then
strOutPut = cl.Value
Else
strOutPut = strOutPut & Delim & cl.Value
End If
Next
rng2.Value = strOutPut
End Sub
Within the context of a worksheet-level code, the following will work. Column 2 is hard-coded, so you might want to pass in a value or otherwise modify it to fit your needs.
Dim rng As Range
Set rng = Me.Columns(2)
Dim row As Integer
row = 1
' Find first row with non-empty cell; bail out if first 100 rows empty
If IsEmpty(Me.Cells(1, 2)) Then
Do
row = row + 1
Loop Until IsEmpty(Me.Cells(row, 2)) = False Or row = 101
End If
If row = 101 Then Exit Sub
' We'll need to know the top row of the range later, so hold the value
Dim firstRow As Integer
firstRow = row
' Combine the text from each subsequent row until an empty cell is encountered
Dim result As String
Do
If result <> "" Then result = result & vbNewLine
result = result & Me.Cells(row, 2).Text
row = row + 1
Loop Until IsEmpty(Me.Cells(row, 2))
' Clear the content of the range
Set rng = Me.Range(Me.Cells(firstRow, 2), Me.Cells(row, 2))
rng.Clear
' Set the text in the first cell
Me.Cells(firstRow, 2).Value2 = result