I am trying to concatenate two columns and paste them into another worksheet in the same workbook. There is a complication in that I have to do this for a predefined range of rows, not the whole column. I have managed to get one column copied over as follows, but I am not sure how to extend this to the concatenation of two columns.
Sub Write_Rows(StartRow As Integer, EndRow As Integer)
Dim CopySheet As Worksheet, PasteSheet As Worksheet
Set CopySheet = Sheets("Sheet1")
Set PasteSheet = Sheets("Master") 'I already made this sheet
CopySheet.Range("B" & StartRow, "B" & EndRow).Copy PasteSheet.Range("A2")
End Sub
What I'm trying to do is exactly like the accepted answer in this question but in Excel not Google Spreadsheets.
You can do this via an array formula, then remove the formula and fix the values. Supposing you want to concatenate columns B and C:
Sub Write_Rows(StartRow As Integer, EndRow As Integer)
Dim dest As Range: Set dest = Sheets("Master").Range("A2:A" & 2 + EndRow - StartRow)
Dim src1 As Range: Set src1 = Sheet1.Range("B" & StartRow & ":B" & EndRow)
Dim src2 As Range: Set src2 = src1.Offset(0, 1)
dest.FormulaArray = "=" & src1.Address(External:=True) & "&" & src2.Address(External:=True)
dest.Value = dest.Value
End Sub
Related
I need to create named ranges from a sheet to which I have added subtotals.
So as shown in the picture I need to create with VBA named ranges for all the groups (E4:F16 shown on the picture). The subtotals are created for each change in Column D ("Group"). The additional rows added by the subtotal wizard (Row 17 as shown) should not be included in the named range. I need to create about 10 similar named ranges in total.
The total number of rows with data on that sheet (I've named it R 14) is fixed but the number of elements within a group is variable. So for instance I need code to find out that cell A17 is empty and create a named range E4:F16.
So far I managed to create a public function that can create a named range given start row, end row, start column and end column:
Public Function createNamedRangeDynamic_1(sheetName As String, _
myFirstRow As Long, _
myLastRow As Long, _
myFirstColumn As Long, _
myLastColumn As Long, _
counter As Integer)
Dim myWorksheet As Worksheet
Dim myNamedRangeDynamic As Range 'declare object variable to hold reference to cell range
Dim myRangeName As String 'declare variable to hold defined name
Set myWorksheet = ThisWorkbook.Worksheets(sheetName) 'identify worksheet containing cell range
myRangeName = sheetName & "_" & counter 'specify defined name
With myWorksheet.Cells
Set myNamedRangeDynamic = .Range(.Cells(myFirstRow, myFirstColumn), .Cells(myLastRow, myLastColumn)) 'specify cell range
End With
ThisWorkbook.Names.Add Name:=myRangeName, RefersTo:=myNamedRangeDynamic 'create named range with workbook scope. Defined name is as specified. Cell range is as identified, with the last row and column being dynamically determined
End Function
My problem is that I can't make any kind of subroutine that can use the above code to produce the named ranges. I tried something like the following:
Sub makeRanges()
Dim sheetName As String
Dim firstRow As Long
Dim nextRow As Long
Dim lastRow As Long 'the lowest row of the group/range
Dim endRow As Long 'the last row with data on the sheet
Dim firstCol As Long
Dim lastCol As Long
Dim cell As Range
Dim myWorksheet As Worksheet
Dim counter As Integer
sheetName = "R 14"
firstCol = 5
lastCol = 6
groupNum = 9
fistRow = 4
endRow = 147
counter = 1
Set myWorksheet = ThisWorkbook.Worksheets(sheetName)
With myWorksheet.Cells
For Each cell In .Range("A" & firstRow, "A" & endRow)
If cell.Value = "" Then
nextRow = cell.Row
Exit For
End If
Next cell
lastRow = nextRow - 1
Call createNamedRangeDynamic_1(sheetName, _
firstRow, _
lastRow, _
firstCol, _
lastCol, _
counter) ' create named range
firstRow = nextRow + 1
counter = counter + 1
End With
End Sub
So that's my progress so far.
you can use Areas property of Range object and boil all that down to:
Option Explicit
Sub makeRanges()
Dim sheetName As String, sheetNameForNamedRange as String
Dim counter As Long
sheetName = "R 14"
sheetNameForNamedRange = Replace(sheetName, " ", "_") ' named range name doesn't accept blanks
Dim area As Range
With ThisWorkbook 'reference wanted workbook
For Each area In .Worksheets(sheetName).Range("A4:A147").SpecialCells(xlCellTypeConstants).Areas ' loop through areas of the not empty cell range along column A in 'sheetName' sheet of referenced workbook
counter = counter + 1 ' update counter
.Names.Add Name:=sheetNameForNamedRange & "_" & Format(counter, "00"), RefersTo:=area.Offset(, 4).Resize(, 2) ' add current named range as current area offset 4 columns to the right and wide two columns
Next
End With
End Sub
note: Format(counter, "00") is to have last two digits as format "_01, "_02", etc..
I am trying to use VBA to filter a table by column's values, and then have a new table (filtered) be output on worksheet, but a new area .Note I want to cell reference the range numbers.
On the fake excel table below. I want to filter for range for column 'age'. I.e. filter --> age --> between 1-3 (cell reference). First table is raw data. Second is what I would like as output using VBA.
I tried fitting the code below to my desired output. It is missing data not relevant to the column itself (taking full columns)
Image of raw data and desired output below
Excel VBA, How to select rows based on data in a column?
Option Explicit
Sub tablefilter()
Dim lastRow As Long, x As Long
Dim lasColumn As Long, i = 4
Dim CopyRange As Range
With Sheets("Sheet1")
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
For x = 1 To lastRow
If Len(Trim(.Range("A" & x).Value)) 1<3 Then
If CopyRange Is Nothing Then
Set CopyRange = .Rows(i)
Else
Set CopyRange = Union(CopyRange, .Rows(x))
End If
End If
Next
If Not CopyRange Is Nothing Then
CopyRange.Copy Sheets("Sheet2").Rows(1)
End If
End With
Figured it out. This is for a model with numbers, not text values. I think there is some inefficiency in the code, but it does work. Main issue is just it uses two sheets instead of creating a new table on same sheet.
D2/D3 are cell reference numbers, and G is the column.
Sub MaturityRange()
Dim ws As Worksheet
Dim Model As Worksheet
Set ws = ThisWorkbook.Sheets("Output")
Set One = ThisWorkbook.Sheets("Model")
If Not IsEmpty(One.Range("D2")) And Not IsEmpty(One.Range("D3")) Then
With ws
.Range("$G$7:$G$" & .Range("G" & Rows.Count).End(xlUp).Row).AutoFilter Field:=1, _
Criteria1:=">" & One.Range("D2").Value, _
Operator:=xlAnd, _
Criteria2:="<" & One.Range("D3").Value
End With
End If
End Sub
How can I dynamically extend the number of rows in two columns that I need to copy to another sheet?
First, I identify the number of rows I need to include and store in totrows:
Dim totrows As Integer
With ThisWorkbook.Worksheets("Sheet1")
totrows = .Range("A" & .Rows.Count).End(xlUp).Row
End With
Next, I am trying to extend the two columns of interest ("B" and "G") so that the range includes that totrows rows. For a static example, if totrows=100 then I would have:
With ThisWorkbook.Worksheets("Sheet1")
.Range("B2:B102,G2:G102").copy
End With
I then paste them into my second sheet with:
ThisWorkbook.Worksheets("Sheet2").Range("A2").Paste
.Range("B2:B102,G2:G102").copy
can be written as
.Range("B2:B" & totrows & ",G2:G" & totrows).Copy
Another way without using .Copy or .Paste would be this:
Sub Copy()
Dim wb As Workbook
Dim wsCopy As Worksheet
Dim wsPaste As Worksheet
Dim totrows As Integer
Set wb = Workbooks("Book1.xlsm")
Set wsCopy = wb.Worksheets("Sheet1")
Set wsPaste = wb.Worksheets("Sheet2")
totrows = wsCopy.Range("A" & wsCopy.Rows.Count).End(xlUp).Row
wsPaste.Range("A1:B" & totrows) = wsCopy.Range("A2:A" & totrows, "G2:G" & totrows).Value
End Sub
This way your directly putting the Values into the Range you want.
i have 2 sheeets. basically ws1 is the destination, ws2 is the source. then i have 2 criterias, an ID Number, and a name of the person who will work on the ID Number.
source contains a row with new actions/progress done by "working person" and need to paste it on the destination in order to update it.
I've read around and saw that autofilter looks like the way to go. i have a code here that autofilters, but i'm just not sure how i can "attack" the problem.
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastrowDest As Long, currow As Long, lastrowSrc As Long
Dim critvalue1 As String
'Destination sheet (dashboard)
Set ws1 = Sheets("Destination")
'Source Sheet (source)
Set ws2 = Sheets("Source")
lastrowSrc = ws2.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
lastrowDest = ws1.Range("A" & Rows.Count).End(xlUp).Row
For currow = 2 To lastrowSrc
critvalue1 = ws2.Range("E" & currow).Value
ws1.Range("A1").AutoFilter field:=5, Criteria1:=critvalue1
Next currow
end sub
is there an easy way to copy the row from source to destination provided that the IDnumber matches? (the IDnumber is unique)
the code above filters but i'm not sure of how to copy or move the rows.
thanks in advance.
This could be done with SUMPRODUCT or VLOOKUP but if you are set on VBA then try this
Sub copyRow()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastrowDest As Long, currowSrc As Long, currowDest As Long, lastrowSrc As Long
Dim critvalue1 As String
Set ws1 = Sheets("Sheet2")
Set ws2 = Sheets("Sheet1")
lastrowSrc = ws2.Range("A" & Rows.Count).End(xlUp).Offset(1).Row - 1
lastrowDest = ws1.Range("A" & Rows.Count).End(xlUp).Row
For currowSrc = 2 To lastrowSrc
critvalue1 = ws2.Range("E" & currowSrc).Value
ws2.Cells(6, 5).Value = critvalue1
For currowDest = 2 To lastrowDest
If ws1.Range("E" & currowDest).Value = critvalue1 Then
ws2.Rows(currowSrc).Copy Destination:=ws1.Range("A" & currowDest)
End If
Next currowDest
Next currowSrc
End Sub
I find it easier than dealing with the autofilter. It goes row by row from the source sheet and checks for a match in every row of the destination sheet. If there is a match, the source row in copied to the matching destination row.
To keep formatting instead of
ws2.Rows(currowSrc).Copy Destination:=ws1.Range("A" & currowDest)
use
ws2.Rows(currowSrc).Copy
ws1.Range("A" & currowDest).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
I pulled this out of a larger macro I use and made some changes to make it match your method a little better and I deleted some irrelevant stuff. The variable names are a bit different. I believe this does what you need. Let me know if it gives you trouble.
Don't forget to populate the ID and Name arrays, set the value for the 2 column variables and assign the sheet names before running.
Sub copyByAutofilter()
Dim filterList1 As Variant
filterList1 = Array("ID1", "ID2")
filterCol1 = 1 'or whatever column contains the IDs
Dim filterList2 As Variant
filterList2 = Array("Name1", "Name2")
filterCol2 = 2 'or whatever column contains the names
Dim sourceWB As String
sourceWB = ThisWorkbook.Name
Dim sourceWS As String
sourceWS = "Sheet2"
Dim destinationWB As String
destinationWB = ThisWorkbook.Name
Dim destinationWS As String
destinationWS = "Sheet3"
lastrowSrc = Sheets(sourceWS).Range("A" & Rows.Count).End(xlUp).Offset(1).Row
lastrowDest = Sheets(destinationWS).Range("A" & Rows.Count).End(xlUp).Row
Workbooks(sourceWB).Sheets(sourceWS).AutoFilterMode = False
Workbooks(sourceWB).Sheets(sourceWS).Range("$A$1:$O" & lastrowSrc).AutoFilter Field:=filterCol1, _
Criteria1:=filterList1, Operator:=xlFilterValues
Workbooks(sourceWB).Sheets(sourceWS).Range("$A$1:$O" & lastrowSrc).AutoFilter Field:=filterCol2, _
Criteria1:=filterList2, Operator:=xlFilterValues
Workbooks(sourceWB).Sheets(sourceWS).Range("A2:O" & lastrowSrc).SpecialCells _
(xlCellTypeVisible).Copy _
Destination:=Workbooks(destinationWB).Sheets(destinationWS).Cells(lastrowDest + 1, 1)
End Sub
One method is by using the Copy method of the Range object. This should generally be avoided though as this overwrites the clipboard. A safer option is to simply use rngDest.Value = rngSrc.Value. Note that for this to work the ranges must be the same size. Here is how this is normally used:
Dim dst As Range
Dim src As Range
Set src = Range("A1:B3") 'Data you want to copy
Set dst = Range("C1") 'First cell in the destination Range
Set dst = dst.Resize(src.Rows.Count, src.Columns.Count) 'Resize to match src
dst.Value = src.Value 'Copy to destination
This method has the benefit of preserving the clipboard!
I am importing some date to worksheet which needs to be ranged for validation and reference in other worksheets.
Say I have 4 columns in worksheet(WS1) but the row count is dynamic on every import. How can i range the columns(A:D)?
Please help.
Regards,
Mani
Use a lastRow variable to determine the last row. I included a few examples of this. Also on this example is a lastCol variable.. You can use this if the number of Columns is dynamic as well.
Private Sub lastRow()
Dim lastRow As Long
Dim lastCol As Long
Dim sheet As String
sheet = "WS1"
lastRow = Sheets(sheet).Range("A" & Rows.Count).End(xlUp).row 'Using Range()
lastRow = Sheets(sheet).Cells(Rows.Count, "A").End(xlUp).row 'Using Cells()
lastCol = Sheets(sheet).Cells(2, Columns.Count).End(xlToLeft).Column
End Sub
You can loop through your sheet easily enough using variables also. Using Cells(row,col) instead of Range(A1). you can use numbers or a letter in quotes for the column as shown in the example.
This example looks at WS1 and matches someValue. If the value in Column A of WS1 = somevalue, the record is copied to a "Master" Sheet.
Sub LoopExample()
Dim mRow As Long 'used for a master row
For lRow = 2 To lastRow
If Sheets(sheet).Cells(lRow, 1) = someValue Then
'perform something here like this. Copy columns A:D to the Master Sheet if match
For lCol = 1 To 4 'or you could go 1 to lastCol if you needed it dynamic
Sheets("MASTER").Cells(mRow, lCol) = Sheets(sheet).Cells(lRow, lCol) 'mRow as Row on Master
Next lCol
mRow = mRow + 1 'Increment the Master Row
End If
Next lRow
End Sub
Thanks anyways. But what i wanted was just to Name ranges the columns in worksheet.
I have already accomplished the copy and paste (Loading data b/w worksheets).
This is what i wanted.
vRowCount = DestWorkSheet.Cells(1, 1).SpecialCells(xlCellTypeLastCell).Row
vColCount = DestWorkSheet.Cells(1, 1).SpecialCells(xlCellTypeLastCell).Column
DestWorkSheet.usedRange.Columns.AutoFit
AddNamedRange Dest_RATES, DATA_Dest_RATES
Where AddNamedRange is a function,
Public Sub AddNamedRange(ByVal sheetCodeName As String, ByVal namedRange As String)
Dim rngToBeNamed As Range
Dim ws As Worksheet
On Error GoTo AddNamedRange_Error
Set rngToBeNamed = GetUsedRange(sheetCodeName)
Set ws = rngToBeNamed.Worksheet
ws.Names.Add name:=namedRange, RefersTo:=ws.Range(rngToBeNamed.Address)
On Error GoTo 0
Exit Sub
AddNamedRange_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure AddNamedRange of Module UtilitiesRange"
End Sub
Regards,
Mani
Seems like you could just use something like this in the sheet module:
Private Sub Worksheet_Change(ByVal target As Range)
Dim i As Long
Dim NamesOfNames(1 To 4) As String
NamesOfNames(1) = "NameOfColumn1"
NamesOfNames(2) = "NameOfColumn2"
NamesOfNames(3) = "NameOfColumn3"
NamesOfNames(4) = "NameOfColumn4"
For i = 1 To 4
ThisWorkbook.Names.Add Name:=NamesOfNames(i), _
RefersTo:=Range(Cells(1, i), Cells(Cells(Rows.Count, i).End(xlUp).Row, i))
Next i
End Sub