I'm trying to Concatenate a range with a single value.
Sub Macro1()
Dim rngOne As Range, strngOne as String, combos As Range
'finds the last row and sets it as the ending range
Dim LastRowColC As Integer
LastRowColC = Range("C65536").End(xlUp).Row
Set rngOne = Worksheets(1).Range("C3" & LastRowColC)
strngOne = "00000"
combos = rngOne & strngOne
Range("D3").Select
Insert combos
End Sub
Why does this not insert the variable "combos" into the cell?
More Explanation (Copied from comments)
Basically I want to take the values in each Cell of column C and add 00000 to the end of all of them. so if C1 was 50 I want the end result to copy over the 50 and replace C1 with 5000000, if C2 was 575 then replace that with 57500000, all throughout the range of data in C.
I would prefer to have it paste over the values in the same column, if that isn't possible. Then for the example you gave I'd want D1= AAA00000, D2=BBB00000, D3 =CCC00000, etc
Is this what you are trying? I have given you two ways.
WAY 1
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long
Dim rng As Range
'~~> Change this to the relevant worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
'~~> Get last row in Col C
lRow = .Range("C" & .Rows.Count).End(xlUp).Row
'~~> Construct your range
Set rng = .Range("C3:C" & lRow)
'~~> Multiply all the cells in the range with 100000
'~~> so that 55 become 5500000, 123 becomes 12300000 and so on
rng.Value = Evaluate(rng.Address & "*100000")
End With
End Sub
WAY 2
Type 100000 in cell D1 and then run this macro
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long
Dim rng As Range
'~~> Change this to the relevant worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
'~~> Get last row in Col C
lRow = .Range("C" & .Rows.Count).End(xlUp).Row
'~~> Construct your range
Set rng = .Range("C3:C" & lRow)
'~~> This cell has 100000
.Range("D1").Copy
'~~> Paste Special Value/Multiply
rng.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlMultiply, _
SkipBlanks:=False, _
Transpose:=False
Application.CutCopyMode = False
End With
End Sub
Related
I have a column with 7000+ names. I want to make each name's length not excess to 5. Here is what I have tried which doesn't work
Sub del()
Dim myCell
Set myCell = ActiveCell
Dim count As Integer
count = Len(ActiveCell)
While count > 5
myCell = Left(myCell, Len(myCell) - 1)
myCell.Offset(1, 0).Select
Set myCell = ActiveCell
Wend
End Sub
No need for VBA. You can use a formula, =Left(A1,5), to get the first 5 characters of the cell. Simply autofill the formula down.
If you still want VBA then also you do not need to loop. See this example. For explanation see Convert an entire range to uppercase without looping through all the cells
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long
Dim rng As Range
'~~> Change this to the relevant sheet
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
Set rng = .Range("A1:A" & lRow)
rng = Evaluate("index(left(" & rng.Address(External:=True) & ",5),)")
End With
End Sub
In the above code I am assuming that the data is in column A in Sheet1. Change as applicable.
In Action
I am trying to add a button, that adds a new column after the last column with values. This works.
Now I want to copy values to the new column. Values shall be copied from the last column from row 32 to the last one with a value in column A.
Right now Ihave a code for copying the whole column. How do I concentrate on the specific range?
Sub AddMeeting()
Dim ws As Worksheet
Dim lastcol As Long
Set ws = ActiveSheet
lastcol = ws.Cells(32, ws.Columns.Count).End(xlToLeft).Column
Columns(lastcol).Copy Destination:=Columns(lastcol + 1)
Range ((Cells.Columns.Count.End(xlLeft)) & Range(32)), (lastcol + 1) & Cells.Rows.Count.End(xlUp)
Application.CutCopyMode = False
End Sub
Values shall be copied from the last column from row 32 to the last one with a value in column A
Is this what you are trying?
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long, lCol As Long
Dim LastColumn As String
Dim rngToCopy As Range
'~~> Set this to the relevant worksheet
Set ws = Sheet1
With ws
'~~> Find last row in Col A
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
'~~> Find last column in row 32
lCol = .Cells(32, .Columns.Count).End(xlToLeft).Column
'~~> Get Column Name from column number
' https://stackoverflow.com/questions/10106465/excel-column-number-from-column-name
LastColumn = Split(Cells(, lCol).Address, "$")(1)
Set rngToCopy = .Range("A32:" & LastColumn & lRow)
Debug.Print rngToCopy.Address
With rngToCopy
'
' Do what you want here
'
End With
End With
End Sub
I've tried multiple codes without luck. I have an excel sheet with 1800 rows and the following columns: ProgramCode, StudyBoard, FacultyID and ProgramType.
In the StudyBoard column there are some cells that are empty. I will then find all the empty cells in StudyBoard and their corresponding information from the other columns. Once I've found the desired cells, they must be overwritten in a new sheet.
I have the following codes, and couldn't continue, because even what I try isn't working.
Dim ws As Worksheet
Dim StudyBoardCol As Range
Dim PromgramCodeCol As Range
Dim rndCell As Range
Dim foundId As Variant
Dim msg As String
Dim FacultyIdCol As Range
Dim ProgramTypeLetter As Range
Set ws = ThisWorkbook.Worksheets("SSBB")
Set StudyBoardCol = ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
Set ProgramCodeCol = ws.Range("B2:B" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row)
Set FacultyIdCol = ws.Range("C2:C" & ws.Cells(ws.Rows.Count, "C").End(xlUp).Row)
Set ProgramTypeLetter = ws.Range("D2:D" & ws.Cells(ws.Rows.Count, "D").End(xlUp).Row)
For i = 2 To 1800
Set rndCell = StudyBoardCol.Cells(Int(Rnd * StudyBoardCol.Cells.Count) + 1)
FacultyIdCol = Application.Match(rndCell.Value, ProgramCodeCol, 0)
ProgramTypeLetter = Application.Match(rndCell.Value, ProgramCodeCol, 0)
You could use SpecialCells to “isolate” blank ones
Dim cell As Range
Dim newSheet As Worksheet
Set newSheet = Sheets.Add
With ThisWorkbook.WorkSheets("SSBB") ‘reference “SSBB” sheet
For Each cell in .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeBlanks) ‘ loop through referenced sheet column A blank cells from row 2 down to last not empty one
cell.Resize(,3).Copy destination:=newSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1) ‘ copy range next to current cell and paste to newSheet column A first empty cell
Next
End With
Or use Autofilter (you probably want to add a test that cells are present to be copied before attempting to set rng
Option Explicit
Public Sub TransferBlankStudyBoard()
Dim rng As Range
With ThisWorkbook.Worksheets("SSBB").UsedRange 'Or limit to columns A:D
.AutoFilter
.AutoFilter Field:=1, Criteria1:="="
Set rng = ActiveSheet.AutoFilter.Range
rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Paste
rng.Offset(1, 0).Resize(rng.Rows.Count - 1).EntireRow.Delete
.AutoFilter
End With
End Sub
I need a macro that need to filter a column and to take out the required date value along with the cell position (i.e say "4/22/2018" cell position "A9 or just 9"). Kindly help me out to fix this issue
See the code that I wrote below
Dim Date As String
Date = Sheets("alldata")
Rows("3:3").Select.AutoFilter.Range("$A$3:$AA$606").AutoFilter , Field:=1, Criterial:="#VALUE!"
Range("A3").Select.xlFilterValues.offset(1, 0).Copy.value
Sheets("Log").Cells(2, "AF").value = Date
Is this what you are trying?
Sub Sample()
Dim ws As Worksheet
Dim rng As Range
Set ws = Sheets("alldata")
With ws
Set rng = .Range("$A$3:$A$606")
'~~> Remove any filters
.AutoFilterMode = False
With rng
.AutoFilter Field:=1, Criteria1:="<>#VALUE!"
'~~> Get the Row Number
MsgBox .Offset(1, 0).SpecialCells(xlCellTypeVisible).Row
'~~> Get The cell Address
MsgBox .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells(1, 1).Address
'~~> Get the Date
Sheets("Log").Cells(2, "AF").Value = _
.Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells(1, 1).Value
End With
'~~> Remove any filters
.AutoFilterMode = False
End With
End Sub
The following will filter the dates and for each date it will copy the value into Sheet Log in Column AF:
Sub foo()
Dim ws As Worksheet: Set ws = Sheets("alldata")
Dim wsLog As Worksheet: Set wsLog = Sheets("Log")
'declare and set your worksheet, amend as required
Dim LastRow As Long, LogLastRow As Long
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
Dim c As Range, rng As Range
ws.Rows("3:3").AutoFilter
ws.Range("$A$3:$AA$" & LastRow).AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(0, "01/01/2018")
Set rng = ws.Range("$A$4:$A$" & LastRow).SpecialCells(xlCellTypeVisible)
For Each c In rng
LogLastRow = wsLog.Cells(wsLog.Rows.Count, "AF").End(xlUp).Row
c.Copy Destination:=wsLog.Cells(LogLastRow, "AF")
'if instead of copying the value, you want to return its address,
'you can get the address by using "c.Address" for each value in the range
Next c
End Sub
I have an excel chart with a bunch of data
Every few rows is blank
When there is a blank row I would like to concatenate the cells in column A and last 4 characters of column B from the row below, as long as the cell in column A below does not equal "."
I have the following:
Sub Macro3()
'
' Macro3 Macro
'
'
For Each cell In Columns("A")
If ActiveCell.Value = "" Then ActiveCell.FormulaR1C1 = _
"=IF(R[1]C<>""."",CONCATENATE(R[1]C,RIGHT(R[1]C[1],4)),"""")"
Range("A2").Select
Next cell
End Sub
Why entire Col A?
If you are using the cell object to loop then why use ActiveCell?
My recommendation is to find the last row in Col A and then take that into account in identifying your actual range and then loop through that.
Is this what you are trying?
Sub Sample()
Dim aCell As Range
Dim lRow As Range
Dim ws As Worksheet
'~~> Change this to the relevant sheet name
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
'~~> Find Last row in col A which has data
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
'~~> Check each cell in the relevant range
For Each aCell In .Range("A1:A" & lRow)
If aCell.Value = "" Then _
aCell.FormulaR1C1 = "=IF(R[1]C<>""."",CONCATENATE(R[1]C,RIGHT(R[1]C[1],4)),"""")"
Next aCell
End With
End Sub