I am trying to insert a formula across all columns (Column B to last column with data) based on value in Column A.
Below is what I have so far:
Sub Insert_Falldown_Ratio_Formula()
Dim Rng As Range
Dim lRow As Long
Dim lLastRow As Long
lLastRow = Cells(Rows.Count, "A").End(xlUp).Row - 1
lastcolumn = Cells(1, Columns.Count).End(xlToLeft).Column
For lRow = lLastRow To 2 Step -1
If Cells(lRow, "A").Value = "Falldown Ratio"
Set Rng = Range("B" & (1Row) & ":" & lastcolumn)
Rng.FormulaR1C1 = "=IF(LEFT(RC[-1],2)=""45"",""45'"",IF(RIGHT(RC[-1],1)=""Q"",""40'HC"",LEFT(RC[-1],2)&""'""))"
End If
Next lRow
End Sub
Any help is greatly appreciated! Thanks!
A few things. (1) You were missing a Then on your If line (2) in the following line you had 1Row instead of lRow and (3) you were copying down rather than across.
Sub Insert_Falldown_Ratio_Formula()
Dim Rng As Range
Dim lRow As Long
Dim lLastRow As Long, lastcolumn As Long
lLastRow = Cells(Rows.Count, "A").End(xlUp).Row - 1
lastcolumn = Cells(1, Columns.Count).End(xlToLeft).Column
For lRow = lLastRow To 2 Step -1
If Cells(lRow, "A").Value = "Falldown Ratio" Then
Set Rng = Range(Cells(lRow, "B"), Cells(lRow, lastcolumn))
Rng.FormulaR1C1 = "=IF(LEFT(RC[-1],2)=""45"",""45'"",IF(RIGHT(RC[-1],1)=""Q"",""40'HC"",LEFT(RC[-1],2)&""'""))"
End If
Next lRow
End Sub
Related
This is my sample data.
I want to select the first empty cell in row 1, which is column D, and use this columnname to fill data using range function. In simple words, i want to fill data in D2:D3. I wrote a code like this- but this writes data to C2:C3 not D2:D3.
Dim row As Long
Dim lastrow As Long
Dim lastcolumn As Variant
lastcolumn = Split(Workbooks("Release.xlsm").Worksheets("Sheet4").Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Cells.Address(1, 0), "$")(0)
lastrow = Workbooks("Release3.xlsm").Worksheets("Sheet4").Cells(Rows.Count, 1).End(xlUp).row
For row = 2 To lastrow
Range(lastcolumn & row).Value = "success"
Next
This is the way:-
Dim R As Long ' "row" is reserved for Excel's use
Dim lastRow As Long
Dim lastColumn As Variant
With Workbooks("Release.xlsm").Worksheets("Sheet4")
' observe the leading period in ".Rows.Count"
lastRow = .Cells(.Rows.Count, 1).End(xlUp).row
lastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
For R = 2 To lastRow
.Cells(R, lastColumn).Value = "success"
Next
End With
The difference between lastRow and lastColumn in your setup is that you want to know the last used row but the next free column. [next free] = [last used] + 1. I think your contraption actually works - didn't test - but the above is more main stream.
you don't need to loop, just use Value property over the whole range
Dim lastRow As Long
Dim lastColumn As Variant
With Workbooks("Release.xlsm").Worksheets("Sheet4")
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
lastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
.Range(.Cells(2, lastColumn), .Cells(lastRow, lastColumn)).Value = "success"
End With
I try to copy last entire row to another sheet but failed
with this method it"s only copying single cell to all the row
Dim lrow As Long
With Worksheets("101")
lrow = .Range("B" & .Rows.Count).End(xlUp).Row
.Range("B" & lrow - 1, "M" & lrow).Copy
Worksheets("EOM").Range("B4").PasteSpecial xlPasteAll
End With
with this code it gives error
Dim shRead As Worksheet
Set shRead = ThisWorkbook.Worksheets("101")
Dim lastRow As Long, lastCol As Long
lastRow = shRead.Cells(shRead.Rows.Count, 2).End(xlUp).Row
lastCol = shRead.Cells(lastRow, shRead.Columns.Count).End(xlToLeft).Column
With shRead
shRead.Range(lastRow, lastCol).Copy_
Worksheets("EOM").Range(B4, M4)
End With
error on
shRead.Range(lastRow, lastCol).Copy_
In place of your code
With shRead
shRead.Range(lastRow, lastCol).Copy_
Worksheets("EOM").Range(B4, M4)
End With
You have to put start and end cell for a range
With shRead
.Range(.Cells(lastRow, 1), .Cells(lastRow, lastCol)).Copy Worksheets("EOM").Range("B4")
End With
for the destination the cell reference should be in double quotes
EDIT
You can use a code similar to the below one; to get data from all worksheets a loop is needed, you can amend the code according to your requirements
Dim i As Integer
i = 4
For Each ws In ActiveWorkbook.Worksheets
With ws
lastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
lastCol = .Cells(lastRow, .Columns.Count).End(xlToLeft).Column
.Range(.Cells(lastRow, 1), .Cells(lastRow, lastCol)).Copy Worksheets("EOM").Range("B" & i)
i = i + 1
End With
Next
I am trying to create a macro to copy and paste data from one Sheet to another sheet when Header and Column A data is matching and want to paste into the specific cell.
below code is working fine for me when Row(headers) order is the same in both sheets. but I need a solution for when the row (Headers) are not in the order.
"I hope I was able to explain my problem"
Sub transfer()
Dim i As Long, j As Long, lastrow1 As Long, lastrow2 As Long
Dim myname As String
lastrow1 = Sheets("sheet1").Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow1
myname = Sheets("sheet1").Cells(i, "A").Value
Sheets("sheet2").Activate
lastrow2 = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
For j = 2 To lastrow2
If Sheets("sheet2").Cells(j, "A").Value = myname Then
Sheets("sheet1").Activate
Sheets("sheet1").Range(Cells(i, "B"), Cells(i, "F")).Copy
Sheets("sheet2").Activate
Sheets("sheet2").Range(Cells(j, "D"), Cells(j, "H")).Select
ActiveSheet.Paste
End If
Next j
Application.CutCopyMode = False
Next i
Sheets("sheet1").Activate
Sheets("sheet1").Range("A1").Select
End Sub
if i understood your goal then may try something like (code is tested with makeshift data)
Sub test()
Dim SrcWs As Worksheet, TrgWs As Worksheet
Dim Col As Long, TrgLastRw As Long, SrclastRw As Long, SrcLastCol As Long, TrgLastCol As Long
Dim SrcRng As Range, TrgRng As Range, C As Range, Hd As String
Set SrcWs = ThisWorkbook.Sheets("Sheet1")
Set TrgWs = ThisWorkbook.Sheets("Sheet2")
SrcLastCol = SrcWs.Cells(1, Columns.Count).End(xlToLeft).Column
TrgLastCol = TrgWs.Cells(1, Columns.Count).End(xlToLeft).Column
For Col = 1 To SrcLastCol
Hd = SrcWs.Cells(1, Col).Value
If Hd <> "" Then
SrclastRw = SrcWs.Cells(Rows.Count, Col).End(xlUp).Row + 1
Set SrcRng = SrcWs.Range(SrcWs.Cells(2, Col), SrcWs.Cells(SrclastRw, Col))
With TrgWs.Range(TrgWs.Cells(1, 1), TrgWs.Cells(1, TrgLastCol))
Set C = .Find(Hd, LookIn:=xlValues) 'each column header is searched in trgWs
If Not C Is Nothing Then
TrgLastRw = TrgWs.Cells(Rows.Count, C.Column).End(xlUp).Row + 1
Set TrgRng = TrgWs.Cells(TrgLastRw, C.Column).Resize(SrcRng.Rows.Count, 1)
SrcRng.Copy Destination:=TrgRng
End If
End With
End If
Next Col
End Sub
I'm trying to display the contents of a merged cell in a For loop in Excel using VBA.
I have the a worksheet with very simple data in it
Here is my code:
'finding last record in my initial list
sheet_last_row = Sheets("mylist").Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To sheet_last_row
last_row = Sheets("results").Cells(Rows.Count, 1).End(xlUp).Row
If Sheets("mylist").Cells(i, 1).Value = 2 Then
'test if cell is merged
If Sheets("mylist").Cells(i, 2).MergeCells Then
RowCount = Sheets("mylist").Cells(i, 2).Value
End If
Sheets("mylist").Cells(i, 1).EntireRow.Copy Sheets("results").Cells(last_row + 1, 1)
End If
Next i
I'm getting the following result with this code;
I'm new at this. Can anyone show me how to make this work.
You could try:
Option Explicit
Sub test()
Dim LastRowA As Long, LastRowB, LastRowC As Long, LastRowE As Long, MaxRow As Long
Dim cell As Range, rng As Range
With ThisWorkbook.Worksheets("Sheet1")
'Find the lastrow for all the available columns
LastRowA = .Cells(.Rows.Count, "A").End(xlUp).Row
LastRowB = .Cells(.Rows.Count, "B").End(xlUp).Row
LastRowC = .Cells(.Rows.Count, "C").End(xlUp).Row
'Get the longer last row in order to avoid losing data if the last cell of a column is merge or empty
MaxRow = WorksheetFunction.Max(LastRowA, LastRowB, LastRowC)
'Set the area to loop
Set rng = .Range("A2:C" & MaxRow)
'Start looping
For Each cell In rng
'If the cell is merger
If cell.MergeCells Then
'Find the last row of column E
LastRowE = .Cells(.Rows.Count, "E").End(xlUp).Row
'Paste cell value in column E
.Range("E" & LastRowE + 1).Value = cell.Value
'Paste cell address in column F
.Range("F" & LastRowE + 1).Value = cell.Address
End If
Next
End With
End Sub
Results:
I need to transfer or move the value of Column F until last cell with value to Column D if Column C is eq to 'RRR'. I can't highlight or select the range starting from the Location of 'RRR' to the last cell with value 'SSS'. Instead, it select range from C4:C9 which is wrong.
Dim ws As Worksheet, lRow As Long
Set ws = ThisWorkbook.ActiveSheet
lRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
Dim lCol As Long
With ws
For x = 1 To lRow
If .Cells(x, 3).Value = "RRR" Then
lCol = Cells(x, Columns.Count).End(xlToLeft).Column
Range("C" & x & ":C" & lCol).Select
End If
Next x
End With
Example:
Expected:
Can anyone tell me the problem in my code.
You are very near, only the select range that should be modified.
So you can build your range:
Range(A1:D1) -> Range(Cells(A1), Cells(D1)) ->
Range(Cells(row number, column number), Cells(row number, column number)) ->
Range(Cells(1, 1), Cells(1, 4))
This should do the trick:
Dim ws As Worksheet, lRow As Long
Dim x As Long
Set ws = ThisWorkbook.ActiveSheet
lRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
Dim lCol As Long
With ws
For x = 1 To lRow
If .Cells(x, 3).Value = "RRR" Then
lCol = Cells(x, Columns.Count).End(xlToLeft).Column 'Find the last column number
Range(Cells(x, 6), Cells(x, lCol)).Cut Cells(x, 4) 'Cut from row x and Column F (Column F = 6) to row x and column "lCol". Then paste the range into row x and column 4.
End If
Next x
End With
End Sub
An alternative method would be to delete the cells in columns D and E
Dim ws As Worksheet, lRow As Long
Dim x As Long
Set ws = ThisWorkbook.ActiveSheet
lRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
Dim lCol As Long
With ws
For x = 1 To lRow
If .Cells(x, 3).Value = "RRR" Then .Range("C" & x & ":D" & x).Delete Shift:=xlToLeft
End If
Next x
End With
End Sub