I would like to have a user select a subset of a range and use a macro to select the much larger range to the clipboard for copying to a different workbook.
User Input:
Range("A1:A5")
Copied Range:
Range("A1:DM5")
Now how about:
User Input:
Range("A1:C5")
Copied Range:
Range("A1:DM5")
Thanks for any advice in advance.
klaus2
Dim rng As Range
Set rng = Application.Intersect(Selection.EntireRow, Range("A:DM"))
If Not rng Is Nothing Then
rng.Copy
'etc etc
End If
Sorry, I have not been around for a few days.
I have come up with a solution that appears to give me what I want. I found the key through Googling.
Dim strSelection As String
Dim firstRow As Integer
Dim lastRow As Integer
Dim firstCell As String
Dim lastCell As String
Sub Macro3()
strSelection = Selection.Address(ReferenceStyle:=xlA1, _
RowAbsolute:=False, ColumnAbsolute:=False)
firstRow = Range(strSelection).Row
lastRow = Range(strSelection).Rows.Count + Range(strSelection).Row - 1
firstCell = "A" & firstRow 'will always be "A" + firstRow
lastCell = "I" & lastRow 'will always predetermined column + lastRow
Range(firstCell, lastCell).Select 'selects the range and ready for copying to another workbook
MsgBox firstCell 'testing
MsgBox lastCell 'testing
End Sub
Related
I want to build a dynamic reporting, and for that, if the header is equal to a specific text then sum the entire column below the header. This is the code that I have.
Sub FindIfSumColumn()
Dim LastRow As Long
Dim rgFound As Range
Dim mFound As Range
Dim bd As Worksheet: Set bd = Sheets("BDD")
Dim dt As Worksheet: Set dt = Sheets("DICT")
LastCol = bd.Cells(1, Columns.Count).End(xlToLeft).Column
Set mFound = dt.Range("B2")
Set rgFound = bd.Range("A1:XFD" & LastCol).Find(What:=mFound, _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns)
If rgFound Is Nothing Then
MsgBox "Nothing"
Else
LastRow = rgFound.Cells(Rows.Count, 1).End(xlUp).Row
dt.Range("B4") = Application.WorksheetFunction.Sum(LastRow)
End If
End Sub
Logic:
Find the header
Get the row below the header
Get the last row under that header
Create your range to sum
Find sum
TIP: It will be easier if you give meaningful names to your variables. That way it will be easier to understand what they are for
Is this what you are trying?
Option Explicit
Sub FindIfSumColumn()
Dim StartRow As Long, LastRow As Long
Dim FoundColumn As String
Dim StringToFind As String
Dim ResultRange As Range
Dim sumRng As Range
Dim bd As Worksheet: Set bd = Sheets("BDD")
Dim dt As Worksheet: Set dt = Sheets("DICT")
StringToFind = dt.Range("B2").Value
Set ResultRange = bd.Cells.Find(What:=StringToFind, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns)
If ResultRange Is Nothing Then
MsgBox "Nothing"
Else
'~~> Get the row after the header
StartRow = ResultRange.Row + 1
'~~> Column of the header
FoundColumn = Split(Cells(, ResultRange.Column).Address, "$")(1)
'~~> Last row under that header
LastRow = bd.Range(FoundColumn & bd.Rows.Count).End(xlUp).Row
'~~> The range that we need to sum
Set sumRng = bd.Range(FoundColumn & StartRow & ":" & FoundColumn & LastRow)
'~~> Output
dt.Range("B4") = Application.WorksheetFunction.Sum(sumRng)
End If
End Sub
Replace, please, your code row
dt.Range("B4") = Application.WorksheetFunction.Sum(LastRow)
with
dt.Range("B4") = Application.WorksheetFunction.Sum(bd.Range(rgFound.Offset(1, 0), rgFound.Offset(lastRow, 0)))
I want to convert a range of cells from integer to String. However, since I have so much data, I can't use a standard loop for ranges as it takes too long.
Instead I thought to use the array and convert the desired range(array) into string values.
This is what I tried to do by modifying my standardcode that converts range into string just instead range I would use in the below the array:
Sub CovertToString()
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
Dim sArray As Variant
Dim LastRow As Integer
Dim cell As Variant
With ws
LastRow = .Cells(.rows.Count, 1).End(xlUp).row
sArray = .Range(.Cells(1, 8), .Cells(LastRow, 8))
For Each cell In sArray
cell = "'" & cell.Value
Next
End With
End Sub
Unfortunately, It does not work which I understand as I am not sure how to correct it.
This way will convert the cell formats to Text:
Sub ConvertToString()
Dim ws As Worksheet
Dim LastCell As Range
Dim rCell As Range
Set ws = ThisWorkbook.Worksheets("Sheet1")
With ws
Set LastCell = .Cells(.Rows.Count, 1).End(xlUp).Offset(, 7)
'Convert format to 'Text'
.Range(.Cells(1, 8), LastCell).NumberFormat = "#"
End With
End Sub
This way will copy the range to an array and add a ' to each value before posting back to the sheet:
Sub ConvertToString()
Dim ws As Worksheet
Dim LastCell As Range
Dim vValues() As Variant
Dim R As Long
Set ws = ThisWorkbook.Worksheets("Sheet1")
With ws
'Your code is looking for last cell in column A, so offset to column H once found.
'This is a reference to the last cell, not the row number so can be used in the range.
Set LastCell = .Cells(.Rows.Count, 1).End(xlUp).Offset(, 7)
vValues = .Range(.Cells(1, 8), LastCell).Value
'Add a ' to each value.
For R = 1 To UBound(vValues, 1)
vValues(R, 1) = "'" & vValues(R, 1)
Next R
'Paste back to sheet.
.Range(.Cells(1, 8), LastCell) = vValues
End With
End Sub
Further reading on arrays & worksheets
I'm trying to dynamically define a range in row like ctrl+down or ctrl+shift+down (to next blank cell) to be used with "For Each itm In rng" statement.
Originally I had it static like this set rng = Range("A4:A10")
So I tried to change it to something like this
Dim rng As Range
Set rng = Range("A4").CurrentRegion.Rows.Count
For Each itm In rng
...
Next itm
I also tried something like this
Set StartCell = Range("A4")
rng = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
But the code doesn't seems to work with "For Each itm In rng" statement
Any help is very much appreciated.
You can use .xlDown, it's the equivalent of pressing ctrl+Shift+down.
Dim rng As Range
Dim lastRow As Long
lastRow = Range("A4").End(xlDown).Row
Set rng = Range("A4:A" & lastRow)
For Each itm In rng
'do something
Next itm
Try this if it helps:
Option Explicit
Sub Test()
Dim LastRow As Long 'to find the last row on your range
Dim MyRange As Range 'to reference the whole range
Dim C As Range 'to loop through your range
With ThisWorkbook.Sheets("MySheet") 'change MySheet for your sheet name
LastRow = .Cells(4, 1).End(xlDown).Row 'last row, how? You go down to the last row and then ctrl + up
Set MyRange = .Range("A4:A" & LastRow) 'dynamic range
For Each C In MyRange
'your code
Next C
End With
End Sub
I want to define a variable range in an Excel macro with VBA. The first cell is always A25, but the last cell is moving depending on the number of data collected. This can be E35, or E58, etc. Any idea how to do this?
There are 2 options:
Option 1: the Range you are looking to define is continuous (see screen-shot below):
the easy approach will do:
Option Explicit
Sub DefRange()
Dim Rng As Range
With Worksheets("Sheet1") '<-- modify "Sheet" to your sheet's name
Set Rng = .Range("A25").CurrentRegion
Debug.Print Rng.Address '<-- for debug: will show A25:E35
End With
End Sub
Option 2: the Range you are looking to define, has an empty line in the middle (screen-shot below):
then, the previous method will result with the wrong range
Option Explicit
Sub DefRange()
Dim Rng As Range
Dim LastRow As Long
Dim LastCol As Long
With Worksheets("Sheet1") '<-- modify "Sheet" to your sheet's name
Set Rng = .Range("A25").CurrentRegion
Debug.Print Rng.Address '<-- for debug: will show A25:E35 ***WRONG***
'Search for any entry, by searching backwards by Rows.
LastRow = .Cells.Find(What:="*", After:=.Range("A25"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'Search for any entry, by searching backwards by Columns.
LastCol = .Cells.Find(What:="*", After:=.Range("A25"), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Set Rng = .Range(.Cells(25, "A"), .Cells(LastRow, LastCol))
Debug.Print Rng.Address '<-- for debug: will show A25:F37 ***CORRECT***
End With
End Sub
You can define a range as its two limit cells. Let's say you are working in the worksheet "ws":
Dim rng As Range
Dim cl1 As Range: Set cl1 = ws.Range("A25")
Dim cl2 As Range
Set cl2 = ws.Range("E35") 'Or something else'
Set rng = ws.Range(cl1, cl2)
Just count the rows in Column E,
Sub Button1_Click()
Dim LstRw As Long
Dim Rng As Range, x
LstRw = Cells(Rows.Count, "E").End(xlUp).Row
x = IIf(LstRw > 25, LstRw, 25)
Set Rng = Range("A25:E" & x)
Rng.Select
End Sub
I have 2 work sheets.
In Sh1 I enter a date in Cell 'R2'.
The macro
should then search Sh2 column 'C' for a match.
When a match is found
it will copy from 2 cells below my match & 74 cells down then
PasteSpecial xlPasteValues in Sh1 Cell 'R3'.
The Below example does something similar but not the desired result.
Option Explicit
Sub FindStr()
Dim rFndCell As Range
Dim strData As String
Dim stFnd As String
Dim fCol As Integer
Dim sh As Worksheet
Dim ws As Worksheet
Set ws = Sheets("CTN ORIGINAL")
Set sh = Sheets("Ctn Daily - (enter data here)")
stFnd = ws.Range("R2").Value
With sh
Set rFndCell = .Range("C:C").Find(stFnd, LookIn:=xlValues)
If Not rFndCell Is Nothing Then
fCol = rFndCell.Column
ws.Range("B3:B33").Copy
sh.Cells(6, fCol).PasteSpecial xlPasteValues
Else 'Can't find the item
MsgBox "No Find"
End If
End With
End Sub
Here, I got one for you, if it is not working let me know. I already tested it and it perfectly work for me.
Option Explicit
Sub findAndCopy()
Dim foundCell As Range
Dim strFind As String
Dim fRow, fCol As Integer
Dim sh1, sh2 As Worksheet
'Set sheets
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
'Get find string
strFind = sh1.Range("R2").Value
'Find string in column C of Sheet2
Set foundCell = sh2.Range("C:G").Find(strFind, LookIn:=xlValues)
'If match cell is found
If Not foundCell Is Nothing Then
'Get the row and column
fRow = foundCell.Row
fCol = foundCell.Column
'copy data from Sheet2 (from 2 cell below & 74 cells down)
sh2.Range(Cells(fRow + 2, fCol).Address & ":" & Cells(fRow + 76, fCol).Address).Copy
'paste in range R3 of Sheet1
sh1.Range("R3").PasteSpecial xlPasteValues
'Clear cache
Application.CutCopyMode = False
'If not found, show message.
Else
Call MsgBox("Not found the match cell!", vbExclamation, "Finding String")
End If
End Sub