I'm very new to VBA and have been using the Macro recorder to create Macros. The Macro recorder can only take me so far, I'm able to accomplish 2/3 of what I need done.
I'm trying to create a Macro where I need criteria met in three Columns, copy the row that meets the criteria, and paste it onto a workbook. The criteria are "Open" "Critical" and "Date." Here's the tricky part, the date either needs to be greater than a specific date, either through user input or referencing a cell in a third worksheet. There are a few thousand rows, and about 19 columns, and all the codes I've attempted lead to crashing excel.
Sample of the code to getting the first two criteria:
Sheets("Sheet1").Select
ActiveSheet.ListObjects("Table_owssvr").Range.AutoFilter Field:=12, _
Criteria1:="Open"
ActiveSheet.ListObjects("Table_owssvr").Range.AutoFilter Field:=16, _
Criteria1:="Critical"
Range("Table_owssvr").Select
Range("Q83").Activate
Selection.Copy
Sheets("Sheet2").Select Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
A-----------------------------------------------------------------B-----------------------------------------------------------C Open -------------------------------------------------------Critical--------------------------------------------------1/25---Open-------------------------------------------------------High------------------------------------------------------3/25 Closed----------------------------------------------------Critical----------------------------------------------------3/24 Open------------------------------------------------------Critical-----------------------------------------------------1/25
Any help would be great!
If you are going to be writing VBA you will have to eventually stop relying on .Select. Recorded code is fine short term but it is typically verbose and inefficient.
Option Explicit
Sub wqewqwew()
Dim col1 As Long, col2 As Long, col3 As Long, dt As Date
Dim ws2 As Worksheet
Set ws2 = Worksheets("sheet2")
With Worksheets("sheet1").ListObjects("Table_owssvr")
With .HeaderRowRange
col1 = Application.Match("open", .Cells, 0)
col2 = Application.Match("critical", .Cells, 0)
col3 = Application.Match("date", .Cells, 0)
dt = CDate(Application.InputBox(prompt:="greater then when?", Title:="pick date", Default:=Date))
End With
With .Range
.AutoFilter
.AutoFilter field:=col1, Criteria1:="open"
.AutoFilter field:=col2, Criteria1:="critical"
.AutoFilter field:=col3, Criteria1:=">" & dt
End With
With .DataBodyRange
If CBool(Application.Subtotal(103, .Cells)) Then
.Copy Destination:=ws2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End If
End With
With .Range
'turn off filters
.AutoFilter
End With
End With
End Sub
You will likely want to research error control and add some to the above.
Recommended reading: How to avoid using Select in Excel VBA .
I designed it this way. Try it.
The complete file is below the link
Sheet1 : It's your row data and click function button
Sheet2 : It's mapping data according to "Open" & "Critical" & "Date" (The "Date" entered according to Sheet3)
Sheet3 : Enter the date you want
The complete code is as follows
Option Explicit
Private Sub Click_Click()
Dim i As Integer
For i = 2 To Worksheets("Sheet1").Range("A65536").End(xlUp).Row
If Worksheets("Sheet1").Range("A" & i) = "Open" And _
Worksheets("Sheet1").Range("B" & i) = "Critical" And _
Worksheets("Sheet1").Range("C" & i) > Worksheets("Sheet3").Range("A2") Then
Worksheets("Sheet1").Rows(i).Copy Worksheets("Sheet2").Range("A" & Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1)
End If
Next
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.