I know how to find the last row, and add a SUM() to that, but how do I SUM(G+H) in column O for each row of the used range?
I would use this to get the last row and sum columns, how could this be converted to sum rows?
With ws
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
LastRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
LastRow = 1
End If
.Range("C" & LastRow + 1).FormulaR1C1 = "=SUM(R[-" & LastRow & "]C:R[-1]C)"
.Range("C" & LastRow + 1 & ":M" & LastRow + 1).FillRight
End With
Something like this would get G + H in column O:
Sub testme()
Dim l_counter As Long
For l_counter = 1 To 100
ActiveSheet.Cells(l_counter, 15).FormulaR1C1 = "=RC7+RC8"
Next l_counter
End Sub
Just make sure that you change the 100 to a variable, in your case, LastRow
Related
I want to loop or find multiple value in another sheets. My code doesn't work even after I do..loop the code.
For i = 1 To lastrowBAU
Worksheets(fname).Range("A1:A" & lastrowsheet).Select
Do Until Cell Is Nothing
Set Cell = Selection.find(What:=ThisWorkbook.Worksheets("BAU").Range("A" & i).Value, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
MatchCase:=False)
If Not Cell Is Nothing Then
Cell.Activate
ActiveCell.Copy
ActiveCell.Insert Shift:=xlShiftDown
ActiveCell.Offset(1, 0).Select
Selection.Replace What:=ThisWorkbook.Worksheets("BAU").Range("A" & i).Value, _
replacement:=ThisWorkbook.Worksheets("BAU").Range("B" & i).Value, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
Set Cell = Worksheets(fname).Range("A1:A" & lastrowsheet).FindNext(Cell)
End If
Loop
Next i
You need to set the cell before entering the loop
Set cell = rngSrc.Find(sA, LookIn:=xlFormulas, LookAt:=xlPart, _
After:=rngSrc.Cells(rngSrc.Cells.Count), SearchOrder:=xlByRows, MatchCase:=False)
If Not cell Is Nothing Then
however you also need to avoid an endless loop by checking if the search has returned to the first one found.
Option Explicit
Sub macro1()
Dim ws As Worksheet, wsBAU As Worksheet
Dim cell As Range, rngSrc As Range
Dim fname As String, lastrow As Long, lastrowBAU As Long
Dim i As Long, n As Long, first As String
Dim sA As String, sB As String
fname = "Sheet1"
With ThisWorkbook
Set ws = .Sheets(fname)
Set wsBAU = .Sheets("BAU")
End With
With ws
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rngSrc = .Range("A1:A" & lastrow)
End With
With wsBAU
lastrowBAU = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With ws
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rngSrc = .Range("A1:A" & lastrow)
End With
' search and replace
Application.ScreenUpdating = False
For i = 1 To lastrowBAU
sA = wsBAU.Cells(i, "A")
sB = wsBAU.Cells(i, "B")
Set cell = rngSrc.Find(sA, LookIn:=xlFormulas, LookAt:=xlPart, _
After:=rngSrc.Cells(rngSrc.Cells.Count), SearchOrder:=xlByRows, MatchCase:=False)
If Not cell Is Nothing Then
first = cell.Address
Do
' insert cell above
cell.Insert xlDown
cell.Offset(-1).Value2 = cell.Value2
cell.Value2 = Replace(cell.Value2, sA, sB)
' expand search range
n = n + 1
Set rngSrc = ws.Range("A1:A" & lastrow + n)
' find next
Set cell = rngSrc.FindNext(cell)
Loop While cell.Address <> first
End If
Next
Application.ScreenUpdating = True
MsgBox n & " replacements", vbInformation
End Sub
I am very new to Excel, VBA and Macros... I am trying to create a macro that added column named "XXX" at last i.e. after the last column and then in that newly added column macro should find 2 columns...
1.Copy and paste the Header Format
.Cells(1, LastCol).Copy
.Cells(1, LastCol + 1).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Apply Formula to "Response Time" column range
For i = 2 To LastRow
.Cells(i, LastCol + 1).Formula = .Cells(i, col2) - .Cells(i, col1)
Next i
Convert Decimal Number to Time format
.Cells(i, LastCol + 1).NumberFormat = "hh:mm:ss"
EDIT: [Full Code]
Option Explicit
Sub addformula()
Dim LastRow As Long
Dim LastCol As Long
Dim iRow As Long
Dim wsh As Worksheets
Dim col1 As Long, col2 As Long
With ActiveWorkbook.Worksheets("Formula testing")
'Find Full Out Gate at Inland or Interim Point (Destination)_actual and Full Out Gate at Inland or Interim Point (Destination)_recvd
With ActiveWorkbook.Worksheets("Formula testing")
col1 = .Cells.Find(What:="Full Out Gate at Inland or Interim Point (Destination)_actual", _
After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Column
col2 = .Cells.Find(What:="Full Out Gate at Inland or Interim Point (Destination)_recvd", _
After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Column
With ActiveWorkbook.Worksheets("Formula testing")
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
.Cells(1, LastCol + 1).Value = "Response Time"
' Copy Header Fromat
.Cells(1, LastCol).Copy
.Cells(1, LastCol + 1).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
' Apply Formula to "Response Time" column range
For i = 2 To LastRow
.Cells(i, LastCol + 1).Formula = .Cells(i, col2) - .Cells(i, col1)
.Cells(i, LastCol + 1).NumberFormat = "hh:mm:ss"
Next i
End With
End With
End With
ActiveWorkbook.Worksheets("Formula Testing").UsedRange.Columns.AutoFit
End Sub
I have changed your formula line to below line of code.
Range(Cells(2, LastCol + 1).Address & ":" & Cells(LastRow, LastCol + 1).Address).Formula = "=" & Cells(2, col2).Address(0, 0) & "-" & Cells(2, col1).Address(0, 0)
Please try the below code.
Option Explicit
Sub addformula()
Dim LastRow As Long
Dim LastCol As Long
Dim iRow As Long
Dim wsh As Worksheets
Dim col1 As Long, col2 As Long
With ActiveWorkbook.Worksheets("Formula testing")
With ActiveWorkbook.Worksheets("Formula testing")
col1 = .Cells.Find(What:="Full Out Gate at Inland or Interim Point (Destination)_actual", _
After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Column
col2 = .Cells.Find(What:="Full Out Gate at Inland or Interim Point (Destination)_recvd", _
After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Column
With ActiveWorkbook.Worksheets("Formula testing")
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
.Cells(1, LastCol + 1).Value = "Response Time"
Range(Cells(2, LastCol + 1).Address & ":" & Cells(LastRow, LastCol + 1).Address).Formula = "=" & Cells(2, col2).Address(0, 0) & "-" & Cells(2, col1).Address(0, 0)
End With
End With
End With
ActiveWorkbook.Worksheets("Formula Testing").UsedRange.Columns.AutoFit
End Sub
I am attempting to use variables in what should be a simple addition formula. First I search for the column header in row 3 call "Jan Expense Hours" MsgBox ColL comes back with the letter "I" and MsgBox ColL2 comes back with the letter "J", both of which are correct. lRow comes back with row 55 which is also correct. Although when I try to add these variables to Worksheets("Calcs").Range("F4:F" & lRow).Formula = "=SUM('Resource Details'! & [ColL] & 4: & [ColL2] & 4)" I get an Application-defined or object-defined error on this line of code. Does anyone have an Idea what I am doing wrong? Btw, I'm searching for the column header because the columns do shift on various copies.
Full Procedure:
Sub JanTotHrsFind()
Dim lRow As Long
Dim lCol As Long
Dim strSearch As String
Dim aCell As Range
Dim ColL As String
Dim ColL2 As String
Dim ColNo As Long
Sheets("Resource Details").Activate
'find the column
strSearch = "*Jan Expense Hours*"
Set aCell = Sheets("Resource Details").Rows(3).Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False)
'convert column number to letter
ColNo = aCell.Column
ColL = Split(Cells(, ColNo).Address, "$")(1)
ColL2 = Split(Cells(, (ColNo + 1)).Address, "$")(1) 'adds one more column to right
MsgBox ColL
MsgBox ColL2
lRow = Cells.Find(What:="SUBTOTAL*", _
After:=Range(ColL & "4"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row - 1 'minus 1 row to move above
MsgBox "Last Row: " & lRow
'formula for Jan Expense Hours + Jan Capital Hours
'Worksheets("Calcs").Range("F4:F" & lRow).Formula = "=SUM('Resource Details'!I4:J4)"
'Worksheets("Calcs").Range("F4:F" & lRow).Formula = "=SUM('Resource Details'![" & ColL & "]4:[" & ColL2 & "]4)"
Worksheets("Calcs").Range("F4:F" & lRow).Formula = "=SUM('Resource Details'! & [ColL] & 4: & [ColL2] & 4)"
End Sub
You should not write your variables within brackets.
So:
Worksheets("Calcs").Range("F4:F" & lRow).Formula = "=SUM('Resource Details'!" & [ColL] & "4:" & [ColL2] & "4)"
Can you please try your code as I corrected above and see how it goes.
I try to run a code when column "L" and column "V" stated "Completed" on both. Then column "W" will show "Completed" else it will show "incompleted" but it show compile error "Else withou if".
Below is my code
Sub OverallStatus()
Dim x As Long
Dim lastrow As Long
With Sheet1
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
lastrow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
lastrow = 1
End If
For x = 2 To lastrow
If .Range("L" & x) = "Completed" And .Range("V" & x) = "Completed" Then
.Range("W" & x) = "Completed"
Else: .Range("W" & x) = "Incomplete"
End If
Next
End With
End Sub
Things to change on your code:
New line character after Then, or move this back up at end of the If
Insert End If before the Next
Replace End If above the End Sub with End With
Following is the code to fetch the data from the last column of each sheet and display it in the sheet "MainSheet". Since the last column has merged cells this code also deletes the cells in between
This code displays the data as verical view in the MainSheet and I want to make it horizontal i.e data from the last column of each sheet should be fetched to the rows in the MainSheet and also the merged cells should be taken care of
Sub CopyLastColumns()
Dim cnt As Integer, sht As Worksheet, mainsht As Worksheet, col As Integer, rw As Integer
ActiveSheet.Name = "MainSheet"
Set mainsht = Worksheets("MainSheet")
cnt = 1
For Each sht In Worksheets
If sht.Name <> "MainSheet" Then
sht.Columns(sht.Range("A1").CurrentRegion.Columns.Count).Copy
mainsht.Columns(cnt).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
mainsht.Cells(150, cnt) = sht.Range("A2")
cnt = cnt + 1
End If
Next sht
With mainsht
For col = 1 To cnt
For rw = .Cells(65536, col).End(xlUp).row To 1 Step -1
If .Cells(rw, col) = "" Then
.Cells(rw, col).Delete Shift:=xlUp
End If
Next rw
Next col
End With
End Sub
Thanks in advance
This code copies the last column from every sheet and pastes them as rows in the MainSheet keeping the merged cells intact.
Option Explicit
Sub Sample()
Dim wsI As Worksheet, wsO As Worksheet
Dim wsOLrow As Long, wsILrow As Long, wsILcol As Long
On Error GoTo Whoa
Application.ScreenUpdating = False
Set wsO = Sheets("MainSheet")
wsOLrow = wsO.Cells.Find(What:="*", _
After:=wsO.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row + 1
For Each wsI In ThisWorkbook.Sheets
If wsI.Name <> wsO.Name Then
With wsI
wsILrow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
wsILcol = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
.Range(Split(Cells(, wsILcol).Address, "$")(1) & "1:" & _
Split(Cells(, wsILcol).Address, "$")(1) & _
wsILrow).Copy .Range(Split(Cells(, wsILcol + 1).Address, "$")(1) & "1:" & _
Split(Cells(, wsILcol + 1).Address, "$")(1) & wsILrow)
.Activate
With .Range(Split(Cells(, wsILcol + 1).Address, "$")(1) & "1:" & _
Split(Cells(, wsILcol + 1).Address, "$")(1) & wsILrow)
.UnMerge
.Cells.SpecialCells(xlCellTypeBlanks).Delete shift:=xlUp
End With
wsILrow = .Range(Split(Cells(, wsILcol).Address, "$")(1) & Rows.Count).End(xlUp).Row
With .Range(Split(Cells(, wsILcol + 1).Address, "$")(1) & "1:" & _
Split(Cells(, wsILcol + 1).Address, "$")(1) & wsILrow)
.Copy
wsO.Cells(wsOLrow, 1).PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True
.Delete
End With
wsOLrow = wsOLrow + 1
End With
End If
Next
LetsContinue:
Application.ScreenUpdating = True
MsgBox "Done"
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub