I have been using this code and it is working perfectly but here is one issue which solution is required that i don't want same formula in output it should paste just result rather than this formula =INDEX(J:J,MATCH(I1,I:I,0))"
Sub FindValue()
Dim Lastrow As Long
Dim SourceSheet As Worksheet
Dim SourceLastrow As Long
Set SourceSheet = Worksheets("Summary")
With SourceSheet
SourceLastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With Worksheets("Summary")
Lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("K1:K" & Lastrow).Formula = "=INDEX(J:J,MATCH(I1,I:I,0))"
End With
End Sub
Try this code, please:
Lastrow = Worksheets("Summary").Cells(Rows.Count, "A").End(xlUp).Row
With Worksheets("Summary").Range("K1:K" & lastRow)
.Formula = "=IF(ISNA(INDEX(J:J,MATCH(I1,I:I,0))),"""",INDEX(J:J,MATCH(I1,I:I,0)))"
.Value = .Value
End With
Related
I am copying data from two workbooks to another workbook.
The code written by me works and serves the purpose.
I am having difficulty getting the syntax for using the offset method to copy to next empty row after the first paste.
With wsdly
lrowdly = Cells(Rows.Count, 2).End(xlUp).Row
.Range("A2:O" & lrowdly).ClearContents
wsb.Range("A2:O" & lrowb).Copy .Range("A2")
End With
With wsdly
lrowdly2 = Cells(Rows.Count, 2).End(xlUp).Row
lrowdly3 = lrowdly2 + 1
wsn.Range("A2:O" & lrown).Copy .Range("A" & lrowdly3)
End With
Whole program.
Sub copy_bond_dat()
Dim wbb As Workbook
Dim wbn As Workbook
Dim wbdly As Workbook
Dim wsb As Worksheet
Dim wsn As Worksheet
Dim wsdly As Worksheet
Set wbb = Workbooks("BSE_BOND.xlsm")
Set wbn = Workbooks("NSE_BOND.xlsm")
Set wbdly = Workbooks("Dly_Debt_Trnx_2022_TMP.xlsx")
Set wsb = wbb.Worksheets("BSEDATA")
Set wsn = wbn.Worksheets("NSEDATA")
Set wsdly = wbdly.Worksheets("Dly_Debt_Trnx_2022_TMP")
Dim lrowb As Long
Dim lrown As Long
Dim lrowdly As Long
Dim lrowdly2 As Long
Dim lrowdly3 As Long
With wsb
lrowb = Cells(Rows.Count, 2).End(xlUp).Row
End With
With wsn
lrown = Cells(Rows.Count, 2).End(xlUp).Row
End With
With wsdly
lrowdly = Cells(Rows.Count, 2).End(xlUp).Row
.Range("A2:O" & lrowdly).ClearContents
wsb.Range("A2:O" & lrowb).Copy .Range("A2")
End With
With wsdly
lrowdly2 = Cells(Rows.Count, 2).End(xlUp).Row
lrowdly3 = lrowdly2 + 1
wsn.Range("A2:O" & lrown).Copy .Range("A" & lrowdly3)
End With
wbdly.Close
End Sub
Changing the mentioned code lines to following code lines problem gets resolved.
With wsdly
lrowdly = .Cells(Rows.Count, 2).End(xlUp).Row
.Range("A2:O" & lrowdly).ClearContents
wsb.Range("A2:O" & lrowb).Copy .Range("A2")
wsn.Range("A2:O" & lrown).Copy
.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End With
I need to loop through a column and if a conditions if met copy cell from one sheet to another.
I'm finding problems with the incremental..
In this case double the results.
Thank you in advance.
KR
Sub copycell()
Dim iLastRow As Long
Dim i As Long
Dim erow As Long
erow = 1
iLastRow = Worksheets("Clientes").Cells(Rows.Count, "C").End(xlUp).Row
For i = 13 To iLastRow
If Sheets("Clientes").Cells(i, 3) = "0" Then
Worksheets("Ficheros").Range("B" & erow).End(xlUp).Offset(1) = Sheets("Clientes").Cells(i, 4)
erow = erow + 1
End If
Next i
End Sub
Why not use Autofilter to filter the column C and if the autofilter returns any rows, copy them to the destination sheet?
See if something like this works for you...
Sub CopyCells()
Dim wsData As Worksheet, WsDest As Worksheet
Dim iLastRow As Long
Application.ScreenUpdating = False
Set wsData = Worksheets("Clientes")
Set WsDest = Worksheets("Ficheros")
iLastRow = wsData.Cells(Rows.Count, "C").End(xlUp).Row
wsData.AutoFilterMode = False
With wsData.Rows(12)
.AutoFilter field:=3, Criteria1:="0"
If wsData.Range("D12:D" & iLastRow).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
wsData.Range("D13:D" & iLastRow).SpecialCells(xlCellTypeVisible).Copy
WsDest.Range("B" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
End If
End With
wsData.AutoFilterMode = False
Application.CutCopyMode = 0
Application.ScreenUpdating = True
End Sub
You can achieve your result with AutoFilter, but my answer is trying to resolve your code using the For loop.
Modified Code
Option Explicit
Sub copycell()
Dim iLastRow As Long
Dim i As Long
Dim erow As Long
' get first empty row in column B in "Ficheros" sheet
erow = Worksheets("Ficheros").Range("B" & Rows.Count).End(xlUp).Row + 1
With Worksheets("Clientes")
iLastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
For i = 13 To iLastRow
If .Cells(i, 3) = "0" Then
Worksheets("Ficheros").Range("B" & erow) = .Cells(i, 4)
erow = erow + 1
End If
Next i
End With
End Sub
With the code I am currently using it will paste the information from Worksheet 1 to worksheet 2 in the Top line of worksheet2. What I want next is to use the same code but for different cell values and to copy the information from worksheet 1 to worksheet 2 but in the next available line in worksheet 2.
I have been researching about excel macros and vba for a while now and I am still having trouble. I have worked on not using select and activate within my excel code but I am still having trouble with my code now. I am trying to automate my excel workbook as much as I can for easier use.
Sub Copy()
Dim Cell As Range
Dim myRow As Long
myRow = 1
With Sheets("Sheet1")
For Each Cell In .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
If Cell.Value = "Tuck Chow" And Cell.Offset(0, 1).Value = "OPT" Then
.Rows(Cell.Row).Copy Destination:=Sheets("Sheet2").Rows(myRow)
myRow = myRow + 1
End If
Next Cell
End With
End Sub
I would do something like this:
Sub Copy()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim newRow As Long
'setting sheets
Set sh1 = ThisWorkbook.Worksheets("Sheet1")
Set sh2 = ThisWorkbook.Worksheets("Sheet2")
With sh1
For Each cel In .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
If cel.Value = "Tuck Chow" And cel.Offset(0, 1).Value = "OPT" Then
'getting new row on Sheet2
If sh2.Cells(1, 1) = "" Then
newRow = 1
Else
newRow = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1
End If
'copying
cel.EntireRow.Copy Destination:=sh2.Cells(newRow, 1)
End If
Next cel
End With
'deselecting row
sh2.Cells(1, 1).Select
End Sub
Try:
Option Explicit
Sub test()
Dim LastRow1 As Long, LastRow2 As Long, i As Long
With ThisWorkbook.Worksheets("Sheet1")
LastRow1 = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To LastRow1
If .Range("A" & i).Value = "Tuck Chow" And .Range("B" & i).Value = "OPT" Then
LastRow2 = ThisWorkbook.Worksheets("Sheet2").Cells(ThisWorkbook.Worksheets("Sheet2").Rows.Count, "A").End(xlUp).Row
.Rows(i).Copy ThisWorkbook.Worksheets("Sheet2").Rows(LastRow2 + 1)
End If
Next i
End With
End Sub
I have Born Dates and want apply this formula
=(YEAR(NOW())-YEAR(A2))
in VBA for calculate age for whole row of dates
for example
A B
1 BornDate Age
2 09.06.1991 28
3 02.07.1973
4
5
my code works only for first two and stop without any error.
Sub btn_GetAge()
Dim LastRow As Long
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count).End(xlUp).Row
.Range("B2:B" & LastRow) = "=(YEAR(NOW())-YEAR(A1))"
End With
End Sub
Any idea or choose different formula ?
1) Cells requires a row and column, e.g. A1 is Cells(1,1)
2) Your formula (and better to specify the property) starts in row 2 but refers to A1
Sub btn_GetAge()
Dim LastRow As Long
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("B2:B" & LastRow).Formula = "=(YEAR(NOW())-YEAR(A2))"
End With
End Sub
You were very close:
Sub btn_GetAge()
Dim LastRow As Long
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("B2:B" & LastRow) = "=YEAR(TODAY())-YEAR(A2)"
End With
End Sub
Try:
Option Explicit
Sub Test()
Dim Lastrow As Long, i As Long
Dim CurrenctYear As Long, LoopYear As Long
With ThisWorkbook.Worksheets("Sheet1")
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
CurrenctYear = Year(Now)
For i = 1 To Lastrow
LoopYear = Year(.Range("A" & i).Value)
.Range("A" & i).Offset(0, 1).Value = CurrenctYear - LoopYear
Next i
End With
End Sub
I have a problem with the following vba script.
I want to copy some cells from one sheet to another.
The first sheet is selected based its name. The sheet where i want to paste the cells is selected based on cell B1 in the first sheet.
I am using the following code:
Dim ws as Worksheet
Dim LR3 as Long
Dim LR4 as Long
Dim LR5 as Long
Dim ws3 as Worksheet
For Each ws In ActiveWorkbook.Worksheets
If Not ws.Name Like "BC-*" Then
LR3 = ws.Cells(Rows.Count, 1).End(xlUp).Row
ws.Range("E" & LR3 + 1).Formula = "=SUM(E4:E" & LR3 & ")"
Dim i As Long, n As Long
n = ws.Cells(Rows.Count, 1).End(xlUp).Row
With ws.Range("S1")
.Formula = "=myJoin(A4:A" & n & ","""")"
.Value = .Value
End With
LR4 = ws.Cells(Rows.Count, 6).End(xlUp).Row
ws.Range("F4:F" & LR4).Copy
ws.Range("M4:M" & LR4).PasteSpecial Paste:=xlPasteValues
ws.Range("M4:M" & LR4).RemoveDuplicates Columns:=1, Header:=xlNo
LR5 = ws.Cells(Rows.Count, 13).End(xlUp).Row
ws.Range("M4:M" & LR4).Cut
Set ws3 = ws.Range("B1").Value
ws3.Range("A30").PasteSpecial xlPasteValues
You need to use:
Set ws3 = ActiveWorkbook.Worksheets(ws.Range("B1").Value)
for example. Adjust the workbook if required.