VBA code to generate report based on criteria

[kkyuvaraj]

Hi,

I have an excel sheet (Attached in this thread) with sheets "Checklist" & "CAR", in which i need a VBA code in the checklist sheer in "Generate CAR" button and if click that button CAR report to be generated in "CAR" sheet as provided in the attached excel sheet.

1. VBA code should filter the field "I5" if I6 to I127=CAR, then the filtered data from C6:H127 has to be copied and pasted to "CAR" sheet as given in the attached excel.
2.Further if any data changed in "Checklist" and I click "Generate CAP" again then the previously copied/pasted data in "CAR" has to be removed and fresh data has to be copied & pasted in "CAR" sheet.
3. After copy & paste to "CAR", checklist list show full list without filter.

Experts pls help to create the VBA code as above

by

Yuvaraj

[Bob Phillips]

This should do it



Public Sub GenerateCAR()
Dim wsCAR As Worksheet
Dim wsChecklist As Worksheet
Dim lastrow As Long
Dim i As Long

Application.ScreenUpdating = False

Set wsChecklist = Worksheets("Checklist")
With wsChecklist

lastrow = .Cells(.Rows.Count, "C").End(xlUp).Row
End With

Call DeleteSheet("CAR")
Set wsCAR = Worksheets.Add(After:=wsChecklist)
wsCAR.Name = "CAR"

With wsCAR

With .Range("C2:H2")

.MergeCells = True
.Value = "CORRECTIVE ACTION REPORT"
.HorizontalAlignment = xlCenter
.Font.Size = 20

With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With

.BorderAround Weight:=xlMedium, LineStyle:=xlContinuous
End With

For i = 3 To 8

.Columns(i).ColumnWidth = wsChecklist.Columns(i).ColumnWidth
Next i
.Columns("E").ColumnWidth = 12

With wsChecklist.Range("C5").Resize(lastrow - 4, 7)

.AutoFilter Field:=7, Criteria1:="<>"
.Copy wsCAR.Range("C4")
.AutoFilter
End With

wsCAR.Columns("I").Delete
End With

Debug.Print "All done - " & Now()

Application.ScreenUpdating = True
End Sub

Private Function DeleteSheet(ByVal sh As String) As Boolean

On Error Resume Next
Application.DisplayAlerts = False
Worksheets(sh).Delete
End Function

[大灰狼1976]

Hi Yuvaraj!

Sub Test()
Dim rng As Range
Application.ScreenUpdating = False
With Sheets("Checklist")
Set rng = .Range("b5:i" & Cells(Rows.Count, 3).End(3).Row)
rng.AutoFilter Field:=8, Criteria1:="CAR"
Sheets("CAR").[c2].CurrentRegion.Offset(3).Clear
.Range("c6:c" & Cells(Rows.Count, 3).End(3).Row).Resize(, 6).Copy Sheets("CAR").[c5]
rng.AutoFilter Field:=8
End With
Application.ScreenUpdating = True
End Sub

[kkyuvaraj]

Hi,

Thanks for your response, however if altered any data and regenerate the CAR, then the previous CAR data remains as it is but if I alter any data in checklist and regenerate CAR then all data in CAR has to be removed and new altered data has to be paste din CAR.

[kkyuvaraj]

Hi,

Thanks a ton and it solved my purpose.:)