I am try to come up a code in VBA the will delete from A2(row 2) to the end of rows
Option Explicit
Sub Ticket()
Dim a As Long
Application.Calculation = xlManual
a = ThisWorkbook.Worksheets("Fleet Report").Range("A2").End(xlDown).Row
MsgBox "Last Row is " & a
ThisWorkbook.Worksheets("Fleet Report").Rows("3:a").EntireRow.Delete
End Sub
But I got error message: type mismatch. Does anyone has an idea?
Your line of code for deleting is incorrectly written. It reads:
ThisWorkbook.Worksheets("Fleet Report").Rows("3:a").EntireRow.Delete
When it should say:
ThisWorkbook.Worksheets("Fleet Report").Rows("3:" & a).EntireRow.Delete
Also to avoid row and column numbers, which I personally am not a fan of, you could format it as:
ThisWorkbook.Worksheets("Fleet Report").Range("A3:A" & a).EntireRow.Delete
Hope this helps!
Try this:
Sub Ticket()
Dim a As Long
Dim WB As Workbook, WS As Worksheet
Set WB = ActiveWorkbook
Set WS = WB.Worksheets("Fleet Report")
Application.Calculation = xlManual
a = WS.Range("A2").End(xlDown).Row
MsgBox "Last Row is " & a
Related
I tried googling an answer for why I'm getting this but nothing helps so far. The sheet isn't protected. Any ideas? Thanks.
Sub category_sums()
Set ws = ActiveWorkbook.Sheets("Test")
ws.Activate
Set MyRg1 = ws.Range("$A$2:$A$582")
Set MyRg2 = ws.Range("$H$2:$H$58")
ws.Range("J17").Formula = "=SumIf((MyRg1,""Auto/Transportation"", MyRg2)"
End Sub
Your ranges need to be same length, concatenate address from variables in and drop the additional bracket. Use Option Explicit at the top of your module and declare all your variables.
Option Explicit
Sub category_sums()
Dim ws As Worksheet, MyRg1 As Range, MyRg2 As Range
Set ws = ActiveWorkbook.Worksheets("Test")
ws.Activate
Set MyRg1 = ws.Range("$A$2:$A$582")
Set MyRg2 = ws.Range("$H$2:$H$582")
ws.Range("J17").Formula = "=SumIf(" & MyRg1.Address & ",""Auto/Transportation"", " & MyRg2.Address & ")"
End Sub
I need help modifying a macro that matches the part number (Column C) between two sheets in different workbooks. Then it pastes the info from 'Original' sheet from the range P9:X6500 into the 'New' sheet into the range P9:X6500. The first sheet 'Original' in column C range C9:C6500 is the matching part number column. The 'New' sheet has the same column C with the part number to match. I only want match and paste the visible values.
I originally had this macro code which copy pastes only visible values from one workbook to another that I would like to modify it to match and copy paste:
Sub GetDataDemo()
Const FileName As String = "Original.xlsx"
Const SheetName As String = "Original"
FilePath = "C:\Users\me\Desktop\"
Dim wb As Workbook
Dim this As Worksheet
Dim i As Long, ii As Long
Application.ScreenUpdating = False
If IsEmpty(Dir(FilePath & FileName)) Then
MsgBox "The file " & FileName & " was not found", , "File Doesn't Exist"
Else
Set this = ActiveSheet
Set wb = Workbooks.Open(FilePath & FileName)
With wb.Worksheets(SheetName).Range("P9:X500")
On Error Resume Next
.SpecialCells(xlCellTypeVisible).Copy this.Range("P9")
On Error GoTo 0
End With
End If
ThisWorkbook.Worksheets("NEW").Activate
End Sub
Also here is what I want it to look like:
Original
NEW
I appreciate the help!
try the following where it copies the range from one sheet to the other. You can break up With wb.Worksheets(SheetName).Range("P9:X500") into With wb.Worksheets(SheetName) then use .Range("P9:X500").Copy this.Range("P9") inside the With statement. Avoid using names like i or ii or this and use something more descriptive. The error handling is essentially only dealing with Sheets not being present and i think better handling of that scenario could be done. Finally, you need to turn ScreenUpdating back on to view changes.
Option Explicit
Public Sub GetDataDemo()
Const FILENAME As String = "Original.xlsx"
Const SHEETNAME As String = "Original"
Const FILEPATH As String = "C:\Users\me\Desktop\"
Dim wb As Workbook
Dim this As Worksheet 'Please reconsider this name
Application.ScreenUpdating = False
If IsEmpty(Dir(FILEPATH & FILENAME)) Then
MsgBox "The file " & FILENAME & " was not found", , "File Doesn't Exist"
Else
Set this = ActiveSheet
Set wb = Workbooks.Open(FILEPATH & FILENAME)
With wb.Worksheets(SHEETNAME)
'On Error Resume Next ''Not required here unless either of sheets do not exist
.Range("P9:X500").Copy this.Range("P9")
' On Error GoTo 0
End With
End If
ThisWorkbook.Worksheets("NEW").Activate
Application.ScreenUpdating = True ' so you can see the changes
End Sub
UPDATE: As OP wants to match between sheets on column C in both and paste associated row information across (Col P to Col X) second code version posted below
Version 2:
Option Explicit
Public Sub GetDataDemo()
Dim wb As Workbook
Dim lookupRange As Range
Dim matchRange As Range
Set wb = ThisWorkbook
Set lookupRange = wb.Worksheets("Original").Range("C9:C500")
Set matchRange = wb.Worksheets("ThisSheet").Range("C9:C500")
Dim lookupCell As Range
Dim matchCell As Range
With wb.Worksheets("Original")
For Each lookupCell In lookupRange
For Each matchCell In matchRange
If Not IsEmpty(matchCell) And matchCell = lookupCell Then 'assumes no gaps in lookup range
matchCell.Offset(0, 13).Resize(1, 9).Value2 = lookupCell.Offset(0, 13).Resize(1, 9).Value2
End If
Next matchCell
Next lookupCell
End With
ThisWorkbook.Worksheets("NEW").Activate
Application.ScreenUpdating = True
End Sub
You may need to amend a few lines to suit your environment e.g. change this to meet your sheet name (pasting to).
Set matchRange = wb.Worksheets("ThisSheet").Range("C9:C500")
I get an error for "" at line 28 (If statement). I'm not sure what is the issue as I have defined everything correctly and make sure the paths are corrects. Can someone please help? I'm trying to grab corresponding group for each user from one sheet to another sheet. here is my code:
for each ColValue1 in objWorksheet1.Range("A1:A" & intlastrow1)
introw1= introw1+1
for each ColValue2 in objWorksheet2.Range("A1:A" & intLastRow2)
introw2 = introw2+2
if ColValue1 = ColValue2 then
...
The cells you are looping through should be declared as a range. Then compare their values.
Dim ws As Excel.Worksheet
Set ws = ActiveWorkbook.Sheets("Sheet1")
Dim ColValue1 As Range
Dim ColValue2 As Range
Set ColValue1 = ws.Range("A1")
Set ColValue2 = ws.Range("A2")
If ColValue1.Value = ColValue2.Value Then
MsgBox "They are the same"
Else
MsgBox "They are not the same"
End If
Function DeleteRows()
Dim wb As Workbook
Set wb = Workbooks(ThisWorkbook.Name)
Debug.Print wb.Name
Dim wsName As String
Dim ws As Worksheet
wsName = "SheetX"
Set ws = wb.Worksheets(wsName)
Debug.Print ws.Name
With ws
Debug.Print "ws.name = " & ws.Name
Rows("3:31").Select
Selection.Delete Shift:=xlUp
End With
End Function
I have this function, DeleteRows, that deletes the the rows 3:31 from the worksheet "SheetX".
This only works when "SheetX" is the sheet that is displayed on the screen.
I want it to work when another sheet, lets say "SheetY", in the workbook is displayed. How can I do this?
One way would be to:
1-activate "SheetY"
2-delete the rows
3-activate "SheetX"
But this would not be transparent to the user. Appreciate the help.
You should always try to avoid Select statements. They are almost always unnecessary. That function should be a Sub (because it doesn't have an output) and can be rewritten as a one-liner:
Sub DeleteRows()
ThisWorkbook.Sheets("SheetX").Range("3:31").Delete xlUp
End Sub
I'm a VBA newbie, pretty much learning by modifying existing macros and trial and error, so I apologize if what I am asking seems bush-league.
I combined/modified some macros to pull rows from an external workbook onto my workbook based on criteria. The issue is that I am randomly being given duplicate rows, and I cannot figure out as to why. Can anyone see what the issue is? The second issue I am having is that in addition to the column AF criteria, I would like to filter so that the dates in column E fall between the dates specified in two cells on a different sheet.
I have been trying to use the line:
If DateValue.Sheets("Control")("B1") < ("E1:E" & B) < DateValue.Sheets("Control")("C1") Then
but I am either placing it incorrectly or just completely off on the coding... Can someone help me out with that?
Sub FetchComplaints()
Dim path As String
Dim FileName As String
Dim LastCell As Range
Dim Wkb As Workbook
Dim WS As Worksheet
Dim ThisWB As String
Sheets("Sheet1").Range("A2:S1000").Clear
Sheets("ComplaintsFetched").Activate
Range("A1:AP5000").Clear
ThisWB = ThisWorkbook.Name
Application.EnableEvents = False
Application.ScreenUpdating = False
path = GetFileName
Set Wkb = Workbooks.Open(FileName:=path)
For Each WS In Wkb.Worksheets
WS.Select
B = Application.CountA(Range("A:A"))
If B = 0 Then
Else
For Each cell In Range("AF1:A" & B)
If cell.Value = True Or cell.Value = "Written" Then
Anum = Application.CountA(Workbooks(ThisWB).Sheets("ComplaintsFetched").Range("A:A")) + 1
cell.EntireRow.Copy Workbooks(ThisWB).Sheets("ComplaintsFetched").Range("A" & Anum)
End If
Next cell
End If
Next WS
Wkb.Close False
Application.EnableEvents = True
Application.ScreenUpdating = True
Set Wkb = Nothing
Set LastCell = Nothing
Set LastCell = Nothing
GetFileName is a function which retrieves the path.
Thanks for any help, and sorry if I am missing something very simple.
Try to use this syntax:
If Sheets("Control").Range("B1").Value < Sheets("Control").Range("C" & B).Value ...
Multiple conditions should be combined using And.